Macro help Please

[julievandermeulen]

I have a workbook that creates a new sheet every week and is named by the date. Ex 11-11-2021, 11-18-2021, 11-25-2021, etc.

I need to write a macro that will:
Calculate the last 4 sheets
1. look at the names in cells C146:C233 and take the value in that row of column P146:P233 and add the number of the last 4 sheets and put the totals in V146:V233.
2. look at the names in cell C146:C233 and take the value in that row of column Q146:Q233 and add the number of the last 4 sheets and put the totals in W146:W233.
3. look at the names in cell C146:C233 and take the value in that row of column R146:R233 and add the number of the last for sheets and put the total in X146:X233
Calculate the year to date sheets (first sheet of the year through the most recent sheet)
1. look at the names in cells C146:C233 and take the value in that row of column P146:P233 and add the number of the YTD sheets and put the totals in AB146:AB233
2. look at the names in cell C146:C233 and take the value in that row of column Q146:Q233 and add the number of the YTD sheets and put the totals in AC146:AC233.
3. look at the names in cell C146:C233 and take the value in that row of column R146:R233 and add the number of the YTD sheets and put the total in AD146:AD233
Calculate the last 52 sheets
1. look at the names in cells C146:C233 and take the value in that row of column P146:P233 and add the number of the last 52 sheets and put the totals in AH146:AH233
2. look at the names in cell C146:C233 and take the value in that row of column Q146:Q233 and add the number of the last 52 sheets and put the totals in AI146:AI233.
3. look at the names in cell C146:C233 and take the value in that row of column R146:R233 and add the number of the last 52 sheets and put the total in AJ146:AJ233

So far I haven't written any of it, and am new to VBA so I need very detailed explanation. Or if you think I could do it with a formula that would be great as well.

 

[tonyyy]

Thanks for that. Another question, please... Is the newest sheet (ie, most recent date) the farthest right tab? And the earlier sheets to the left? If so, please see if the following eliminates the error.

Sub Kalculations5()
Dim i As Long, j As Long
Application.ScreenUpdating = False

'Monthly totals
For j = Sheets.Count To Sheets.Count - 3 Step -1
    For i = 146 To 233
        If IsError(Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0)) Then
            ' match not found
        Else
            ActiveSheet.Range("V" & i).Value = ActiveSheet.Range("V" & i).Value + _
                Application.Index(Sheets(j).Range("P146:P233"), _
                Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
            ActiveSheet.Range("W" & i).Value = ActiveSheet.Range("W" & i).Value + _
                Application.Index(Sheets(j).Range("Q146:Q233"), _
                Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
            ActiveSheet.Range("X" & i).Value = ActiveSheet.Range("X" & i).Value + _
                Application.Index(Sheets(j).Range("R146:R233"), _
                Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
        End If
    Next i
Next j

'Year to date totals
For j = Sheets.Count To Sheets.Count - 51 Step -1
    If Right(ActiveSheet.Name, 4) <> Right(Sheets(j).Name, 4) Or j = 1 Then
        Exit For
    Else
        For i = 146 To 233
            If IsError(Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0)) Then
                ' match not found
            Else
                ActiveSheet.Range("AB" & i).Value = ActiveSheet.Range("AB" & i).Value + _
                    Application.Index(Sheets(j).Range("P146:P233"), _
                    Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
                ActiveSheet.Range("AC" & i).Value = ActiveSheet.Range("AC" & i).Value + _
                    Application.Index(Sheets(j).Range("Q146:Q233"), _
                    Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
                ActiveSheet.Range("AD" & i).Value = ActiveSheet.Range("AD" & i).Value + _
                    Application.Index(Sheets(j).Range("R146:R233"), _
                    Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
            End If
        Next i
    End If
Next j

'Yearly totals
For j = Sheets.Count To Sheets.Count - 51 Step -1
    If j = 1 Then
        Exit For
    Else
        For i = 146 To 233
            If IsError(Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0)) Then
                ' match not found
            Else
                ActiveSheet.Range("AH" & i).Value = ActiveSheet.Range("AH" & i).Value + _
                    Application.Index(Sheets(j).Range("P146:P233"), _
                    Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
                ActiveSheet.Range("AI" & i).Value = ActiveSheet.Range("AI" & i).Value + _
                    Application.Index(Sheets(j).Range("Q146:Q233"), _
                    Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
                ActiveSheet.Range("AJ" & i).Value = ActiveSheet.Range("AJ" & i).Value + _
                    Application.Index(Sheets(j).Range("R146:R233"), _
                    Application.Match(ActiveSheet.Range("C" & i).Value, Sheets(j).Range("C146:C233"), 0))
            End If
        Next i
    End If
Next j
Application.ScreenUpdating = True
End Sub

And yet another question... Are there any formulas on the sheets? (If not, we can utilize arrays to speed up the calculations.)

 

[julievandermeulen]

Yes the newest sheet is to the right.

the macro is running now but the calculations are not correct.
4 weeks = multiply everything by 10
YTD = it's multiplying everything by 97
52 weeks = it's multipying everything by 102 or more

Yes P:R have this formula or one similar to this in them
=INDEX($B$10:$H$22,MATCH($C148,$C$10:$C$22,0),4)

 

[tonyyy]

Before you run the macro, are the following ranges empty?

V146:X233
AB146:AD233
AH146:AJ233

 

[julievandermeulen]

No they are not.
I have a macro that copies the previous sheet then updates all the numbers and clears what needs to be clear automatically. I can clear those cells also.

 

[tonyyy]

Yes, please clear those cells also then run the Kalculations macro and check the results.

 

[julievandermeulen]

ok when I clear the cells it works kind of.

On Sheet 12-8-2022 (I keep adding sheets in my mock workbook as I try things)
C188 = Westside R188 = 10
C189 = Wisers R189 = 0

On Sheet 12-15-2022
C188 = Wisers R188 = 0
C189 = Westside R189 = 10

The Results on Sheet 12-22-2022 should be
C188 = Westside X188 = 20
C189 = Wisers X189 = 0

But the results are
C188 = Westide X188 = 10
C189 = Wisers X189 = 0

Everything else looks correct. Just the calculation is the text in Column C changes.

 

[tonyyy]

The macro looks for an exact match in Column C. So in your example in post #16, "Westide" does not match "Westside". Or, if spelled correctly in your mock workbook, could there be a space following one of the names, eg, "Westside " vs "Westside".

 

[julievandermeulen]

In post #16 it is a misspell.
I checked that and actually copy and pasted the names, from sheet to sheet, so they were the same. Then I ran the macro again and I get the same results.

 

[tonyyy]

Could it be that one of the Westside names or values is not within rows 146:233? Or that there's a duplicate Westside on one of the sheets? (Match will only find the first occurrence.) I ask only because the macro runs perfectly on my sample sheets. Of course it does.

That said, I've rewritten the code without Match...

Sub Kalculate4()
Dim LastRow As Long, LastRow2 As Long
Dim i As Long, j As Long, k As Long
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim ws As Worksheet

Application.ScreenUpdating = False
Set ws = ActiveSheet
LastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
arr1 = ws.Range("A1:AJ" & LastRow)

'Monthly totals
ReDim arr3(146 To 233, 1 To 3)
For j = Sheets.Count To (Sheets.Count - 3) Step -1
    LastRow2 = Sheets(j).Cells(Rows.Count, "C").End(xlUp).Row
    arr2 = Sheets(j).Range("A1:AJ" & LastRow2)
    For i = 146 To 233
        For k = 146 To 233
            If arr1(i, 3) = arr2(k, 3) Then
                arr1(i, 22) = arr1(i, 22) + arr2(k, 16) 'vp
                arr1(i, 23) = arr1(i, 23) + arr2(k, 17) 'wq
                arr1(i, 24) = arr1(i, 24) + arr2(k, 18) 'xr
                Exit For
            End If
        Next k
    Next i
    Erase arr2
Next j
For i = 146 To 233
    arr3(i, 1) = arr1(i, 22)
    arr3(i, 2) = arr1(i, 23)
    arr3(i, 3) = arr1(i, 24)
Next i
ws.Range("V146:X233").Value = arr3

'Year to date totals
ReDim arr3(146 To 233, 1 To 3)
For j = Sheets.Count To Sheets.Count - 51 Step -1
    If Right(ws.Name, 4) <> Right(Sheets(j).Name, 4) Or j = 1 Then
        Exit For
    Else
        LastRow2 = Sheets(j).Cells(Rows.Count, "C").End(xlUp).Row
        arr2 = Sheets(j).Range("A1:AJ" & LastRow2)
        For i = 146 To 233
            For k = 146 To 233
                If arr1(i, 3) = arr2(k, 3) Then
                    arr1(i, 28) = arr1(i, 28) + arr2(k, 16) 'abp
                    arr1(i, 29) = arr1(i, 29) + arr2(k, 17) 'acq
                    arr1(i, 30) = arr1(i, 30) + arr2(k, 18) 'adr
                    Exit For
                End If
            Next k
        Next i
        Erase arr2
    End If
Next j
For i = 146 To 233
    arr3(i, 1) = arr1(i, 28)
    arr3(i, 2) = arr1(i, 29)
    arr3(i, 3) = arr1(i, 30)
Next i
ws.Range("AB146:AD233").Value = arr3

'Yearly totals
ReDim arr3(146 To 233, 1 To 3)
For j = Sheets.Count To Sheets.Count - 51 Step -1
    If j = 1 Then
        Exit For
    Else
        LastRow2 = Sheets(j).Cells(Rows.Count, "C").End(xlUp).Row
        arr2 = Sheets(j).Range("A1:AJ" & LastRow2)
        For i = 146 To 233
            For k = 146 To 233
                If arr1(i, 3) = arr2(k, 3) Then
                    arr1(i, 34) = arr1(i, 34) + arr2(k, 16) 'ahp
                    arr1(i, 35) = arr1(i, 35) + arr2(k, 17) 'aiq
                    arr1(i, 36) = arr1(i, 36) + arr2(k, 18) 'ajr
                    Exit For
                End If
            Next k
        Next i
    End If
Next j
For i = 146 To 233
    arr3(i, 1) = arr1(i, 34)
    arr3(i, 2) = arr1(i, 35)
    arr3(i, 3) = arr1(i, 36)
Next i
ws.Range("AH146:AJ233").Value = arr3
Application.ScreenUpdating = True
End Sub

 

[julievandermeulen]

it's in row 188 & 189. No other Westside. I'm glad it works on your practice sheet that encouraging. I feel like we are so close to having it work and I so appreciate your help.

I will try it without the match.