Macro to update Score Card Summary when the new staff add-in or existing staff deleted

Hi,

Can anyone help me to give an idea?

I have 2 workbooks which are "Score card summary" and "Working Data" to be run on a monthly basis. Once the user press update button, Score in the working data will be auto populated into score card summary.

I have created VBA code with specified range for that particular staffs. My problem is if the existing staff resigned, its data will be deleted, thus the specified row will be moved. The same thing will happen if the new staff join, the new data will be add-in.

Thus, when the user press update button, the data will be wrongly populated. I want a macro to be able to update regardless changes made in the row data


sample VBA code for one of the staff, Please refer attachment for all staffs

For i1 = 0 To 5
    If i1 = 0 Then
    Range("D6").Offset(0, i1).Value = Workbooks("Working Data").Worksheets("DS").Range("D5").Offset(0, 2 * i1).Value
    ElseIf i1 <> 0 Then
    Range("D6").Offset(0, i1).Value = Workbooks("Working Data").Worksheets("DS").Range("D5").Offset(0, 2 * i1).Value
    End If
Next i1

Regards,
Farid

Hi Farid,

I'll look at this tomorrow and try to help you then - thanks for asking!

Hi Farid,

I just rewrote the routine - see if you like it:

Sub StaffScore(): Dim wsc As Worksheet, wfd As Workbook, ws As Worksheet
Dim r As Long, c As Long, k As Long, N As String: Set wsc = ActiveSheet
                            Set wfd = Workbooks("Working Data.xlsb")
With CreateObject("Scripting.Dictionary")
        For r = 6 To wsc.Range("C" & Rows.Count).End(xlUp).Row
            N = LCase(Cells(r, 3)): .Item(N) = r: Next r
            
            For Each ws In wfd.Worksheets
                N = LCase(ws.Cells(5, 2))
                    If .Exists(N) Then
                    r = .Item(N)
        c = 4: k = 4: Do Until wsc.Cells(5, c) = ""
        wsc.Cells(r, c) = ws.Cells(5, k): k = k + 2: c = c + 1: Loop
            End If: Next
End With: End Sub

Hi Farid,

This will build your Score Card from your Working Data every time

Sub StaffScore(): Dim wsc As Worksheet, wfd As Workbook, ws As Worksheet
Dim r As Long, c As Long, k As Long, N As String, No As Integer
Set wsc = ActiveSheet: Set wfd = Workbooks("Working Data.xlsb")
        r = wsc.Rows.Find("*", , , , xlByRows, xlPrevious).row
    c = wsc.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
        Range(wsc.Cells(6, 2), wsc.Cells(6, c)).ClearContents
        Range(wsc.Cells(7, 2), wsc.Cells(r, c)).Clear: r = 5
        
        For Each ws In wfd.Worksheets
                If r > 5 Then
        wsc.Range("C" & r).EntireRow.Copy
        wsc.Range("A" & r + 1).PasteSpecial xlPasteFormats
                Application.CutCopyMode = False: End If
                
            N = WorksheetFunction.Proper(ws.Cells(5, 2)): r = r + 1
            wsc.Cells(r, 2) = r - 5: wsc.Cells(r, 3) = N
        c = 4: k = 4: Do Until wsc.Cells(5, c) = ""
        wsc.Cells(r, c) = ws.Cells(5, k): k = k + 2: c = c + 1: Loop
        Next
        Cells(r + 1, 1).Select
End Sub

Hi Farid,

Thanks for the rep!

The program looks at all the worksheets, how ever many there are.

Did you want the program to make new rows on the Score Card??

Hi Farid,

I'm glad that I was able to atone for that looping debacle. Thanks for the compliment and thanks for the rep!