VBA: sumifs data and calculate score base on multiple criteria in cell value

[tendosai]

it is a bit complicated. excuse me!

I have raw_report which contain teacher name and daily attendance for student on each subject. In template, i wanna make a button so that my colleague can click and generate the score of their student base on daily attendance.

1. First, it need to look "Team Name" (one team have multiple teacher)
2. Then, it will base on date of attendance
3. Once data matches based on above criteria, it will copy/paste name of student name into the column (without duplicated) as well as their teacher name.
   In sample excel, Mr. A has 3 members so in table it will also include teacher Mr. E and Mr. F 's student accordingly.
4. with all student name in, it will SUM the subject score and total score according to subject (in sample it can be easily with sumifs but not sure in VBA)

here is the sample file Sample Test

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet(s). Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[tendosai]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet(s). Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

thank so much sir for checking out. i put the sample as well at the bottom. I also make a "what i want" sheet as reference.

 

[mumps]

Mr. A has 3 members so in table it will also include teacher Mr. E and Mr. F 's student accordingly.

Can you please explain in detail referring to specific cells, rows, columns and sheets, how to determine that Mr. A has three members?

 

[tendosai]

Can you please explain in detail referring to specific cells, rows, columns and sheets, how to determine that Mr. A has three members?

oh it was manual from my side. Please allow me to r-eadjust the sample again. we always do it manual before so i didnt think of that clause.

i add "structure" sheet in the excel sample.

 

[mumps]

Try:

Sub CalculateScore()
    Application.ScreenUpdating = False
    Dim LastRow As Long, team As Range, srcWS As Worksheet, desWS As Worksheet, struct As Worksheet, lRow As Long
    Dim arr As Variant, SN As Range, total As Long, Math As Long, PE As Long, Physic As Long, Chemistry   As Long, Social As Long, Bio As Long
    Set srcWS = Sheets("Raw Report")
    Set desWS = Sheets("Template")
    Set struct = Sheets("Structure")
    LastRow = struct.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set team = struct.Rows(1).Find(desWS.Range("H1").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not team Is Nothing Then
        arr = Application.Transpose(struct.Range(team.Address).Resize(LastRow).Value)
        With srcWS
            .Range("A1").CurrentRegion.AutoFilter 4, arr, xlFilterValues
            With CreateObject("Scripting.Dictionary")
                For Each SN In srcWS.Range("C2:C" & lRow).SpecialCells(xlCellTypeVisible)
                    If Not .exists(SN.Value) Then
                        .Add SN.Value, Nothing
                        With srcWS.Range("A1")
                            .CurrentRegion.AutoFilter 3, SN
                            Math = Application.WorksheetFunction.Sum(.Range("E2:E" & lRow).SpecialCells(xlCellTypeVisible))
                            PE = Application.WorksheetFunction.Sum(.Range("F2:F" & lRow).SpecialCells(xlCellTypeVisible))
                            Physic = Application.WorksheetFunction.Sum(.Range("G2:G" & lRow).SpecialCells(xlCellTypeVisible))
                            Chemistry = Application.WorksheetFunction.Sum(.Range("H2:H" & lRow).SpecialCells(xlCellTypeVisible))
                            Social = Application.WorksheetFunction.Sum(.Range("I2:I" & lRow).SpecialCells(xlCellTypeVisible))
                            Bio = Application.WorksheetFunction.Sum(.Range("J2:J" & lRow).SpecialCells(xlCellTypeVisible))
                            total = Application.WorksheetFunction.Sum(.Range("K2:K" & lRow).SpecialCells(xlCellTypeVisible))
                            With desWS
                                .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 9).Value = Array(SN, SN.Offset(, 1), Math, PE, Physic, Chemistry, Social, Bio, total)
                            End With
                        End With
                    End If
                Next SN
            End With
            .Range("A1").AutoFilter
        End With
    End If
    With desWS.Range("A8")
        .Value = "1"
        .AutoFill Destination:=Range("A8").Resize(Range("B" & Rows.Count).End(xlUp).Row - 7), Type:=xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub

 

[tendosai]

Try:

Sub CalculateScore()
    Application.ScreenUpdating = False
    Dim LastRow As Long, team As Range, srcWS As Worksheet, desWS As Worksheet, struct As Worksheet, lRow As Long
    Dim arr As Variant, SN As Range, total As Long, Math As Long, PE As Long, Physic As Long, Chemistry   As Long, Social As Long, Bio As Long
    Set srcWS = Sheets("Raw Report")
    Set desWS = Sheets("Template")
    Set struct = Sheets("Structure")
    LastRow = struct.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set team = struct.Rows(1).Find(desWS.Range("H1").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not team Is Nothing Then
        arr = Application.Transpose(struct.Range(team.Address).Resize(LastRow).Value)
        With srcWS
            .Range("A1").CurrentRegion.AutoFilter 4, arr, xlFilterValues
            With CreateObject("Scripting.Dictionary")
                For Each SN In srcWS.Range("C2:C" & lRow).SpecialCells(xlCellTypeVisible)
                    If Not .exists(SN.Value) Then
                        .Add SN.Value, Nothing
                        With srcWS.Range("A1")
                            .CurrentRegion.AutoFilter 3, SN
                            Math = Application.WorksheetFunction.Sum(.Range("E2:E" & lRow).SpecialCells(xlCellTypeVisible))
                            PE = Application.WorksheetFunction.Sum(.Range("F2:F" & lRow).SpecialCells(xlCellTypeVisible))
                            Physic = Application.WorksheetFunction.Sum(.Range("G2:G" & lRow).SpecialCells(xlCellTypeVisible))
                            Chemistry = Application.WorksheetFunction.Sum(.Range("H2:H" & lRow).SpecialCells(xlCellTypeVisible))
                            Social = Application.WorksheetFunction.Sum(.Range("I2:I" & lRow).SpecialCells(xlCellTypeVisible))
                            Bio = Application.WorksheetFunction.Sum(.Range("J2:J" & lRow).SpecialCells(xlCellTypeVisible))
                            total = Application.WorksheetFunction.Sum(.Range("K2:K" & lRow).SpecialCells(xlCellTypeVisible))
                            With desWS
                                .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 9).Value = Array(SN, SN.Offset(, 1), Math, PE, Physic, Chemistry, Social, Bio, total)
                            End With
                        End With
                    End If
                Next SN
            End With
            .Range("A1").AutoFilter
        End With
    End If
    With desWS.Range("A8")
        .Value = "1"
        .AutoFill Destination:=Range("A8").Resize(Range("B" & Rows.Count).End(xlUp).Row - 7), Type:=xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub

thank so much sir for your code. it works great except missing date filter which suppose to be B4 and B5 (start date and end date) of attendance.

side note: excuse me if i can request for clear the cell data first before add another data in (reason is because my colleague may just use the same excel again next time without changing new one).

 

[tendosai]

update: i found it after many searching and figure out by adding

.Range("A1").CurrentRegion.AutoFilter 2, desWS.Range("B4").Value, xlAnd, "<=" & desWS.Range("B5").Value

now i just have to add a few clean up so it wont error in case on result found only 1 at autofill
and no result found

 

[mumps]

Is everything working as you wanted now?

 

[tendosai]

Is everything working as you wanted now?

yes sir. except the when there are nothing match... it will throw error at SN.value.

so i do as a dumb-er do by throwing "on error go to msgbox" lol. i dont understand the line if not exist .. so i have do the shortcut