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.

 

[julievandermeulen]

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]

Sorry I just responded like 3 times. My grandkids are helping me push buttons.

I ran that macro. It's way faster way faster but I get the same results.

Do you think it's not possible to do the calculations correctly?

 

[tonyyy]

Just for kicks, on the sheet dated "12-8-2022"... change it to "12-08-2022" and see if that makes a difference.

 

[julievandermeulen]

Same results ???

It's so close!

 

[julievandermeulen]

Oh I'm an idiot and way over tired. I was looking at the wrong cell.

IT WORKS!!!!!

Thank you sooo soo much

 

[tonyyy]

Hooray! Glad you figured it out.

When you have a moment, please mark your question as solved. (I think on post #19)

Thanks much and happy holidays!

 

[julievandermeulen]

I will mark it as solved after I try it on my actual workbook, but that won't be until next week.

Thanks so much for all your help. I have another workbook that needs help too, would you mind helping me with that once I have time to sit down and figure out what I need?

 

[tonyyy]

You're very welcome. And of course I'll be happy to help with your other workbooks.

 

[julievandermeulen]

It worked slick! I have Marked as solved. When I get a chance I will ask for help with my other workbook.

Praying you have a very Merry Christmas and a Blessed New Year!

 

[tonyyy]

Thanks, Julie.

You have a Merry Christmas too!