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

T

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

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
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
mumps said:
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).
Click to expand...
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
tendosai said:
Mr. A has 3 members so in table it will also include teacher Mr. E and Mr. F 's student accordingly.
Click to expand...
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
mumps said:
Can you please explain in detail referring to specific cells, rows, columns and sheets, how to determine that Mr. A has three members?
Click to expand...
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
mumps said:
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
Click to expand...

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
Click to expand...
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
mumps said:
Is everything working as you wanted now?
Click to expand...
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
You must log in or register to reply here.

Similar threads

A
  • Question Question
Excel data from one sheet, copy cells from row i'm working on to excel 'form' based on cell value
Replies
2
Views
529
asiuol84
A
A
  • Question Question
How to Insert another loop for inputting multiple receiver name in an Email based on criteria
Replies
3
Views
673
portews
P
J
  • Question Question
VBA copy data from multiple workbooks based on criteria
Replies
6
Views
2K
Jendjieh
J
U
  • Question Question
Rename file Based on Cell value and Criteria
2
Replies
13
Views
12K
unknownymous
U
I
  • Question Question
Power Query - Split Master Table into Multiple table as per value in a column (Dynamic)
Replies
0
Views
7K
ialwayscapital
I

Forum statistics

Threads
1,223,893
Messages
6,175,239
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

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