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

tendosai

New Member
Joined
Mar 14, 2022
Messages
26
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
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
 

Attachments

  • Untitled.png
    Untitled.png
    27.3 KB · Views: 24

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
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).
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
Try:
VBA Code:
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
 
Upvote 0
Try:
VBA Code:
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).
 
Upvote 0
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
 
Upvote 0
Is everything working as you wanted now?
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,224,815
Messages
6,181,135
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top