Need help with a macro

Question

I have a macro that creates a tab for the prior business day (tab named "Collections thru 10.16.25") by copying the previously prior business day tab (tab named "Collections thru 10.15.25"). I need the macro to update a few fields for the new tab. I need it to zero out the amount of "Non-Tenant Receipts" and update the formula for "Total Day's Collections" to add the previously prior business day's "Unposted Receipts" amount and add in the in new tab's "Non-Tenant Receipts" amount. The cells for the amounts referenced above change every day based on receipts collected so the formulas do not reference fixed cells.

Any help would be greatly appreciated.

Answer 1

You can try the following - this uses the label text in column A dynamically to locate rows:

• Finds the latest tab named “Collections thru [date]” by parsing all sheet names.
• Copies that tab and names it for the next business day using WorkDay (which skips weekends).
• Locates rows by searching column A for the key labels ("Non-Tenant Receipts", "Unposted Receipts", "Total Day's Collections").
• Zeroes out Non-Tenant Receipts.
• Builds the formula for “Total Day's Collections” dynamically using cell references from both the old and new sheets.

Sub CreateNewCollectionsTab()
    Dim wsPrev As Worksheet, wsNew As Worksheet
    Dim prevDate As Date, newDate As Date
    Dim prevName As String, newName As String
    Dim foundNonTenant As Range, foundUnposted As Range, foundTotal As Range
    Dim unpostedRef As String, nonTenantRef As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    '--- identify the most recent "Collections thru" sheet
    Dim ws As Worksheet
    Dim latestDate As Date
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "Collections thru *" Then
            Dim dt As Date
            On Error Resume Next
            dt = CDate(Trim(Replace(ws.Name, "Collections thru", "")))
            On Error GoTo 0
            If dt > latestDate Then
                latestDate = dt
                Set wsPrev = ws
            End If
        End If
    Next ws
    
    If wsPrev Is Nothing Then
        MsgBox "No 'Collections thru' sheets found.", vbExclamation
        Exit Sub
    End If
    
    prevDate = latestDate
    newDate = Application.WorksheetFunction.WorkDay(prevDate, 1)
    
    prevName = wsPrev.Name
    newName = "Collections thru " & Format(newDate, "m.d.yy")
    
    '--- copy the previous day's sheet
    wsPrev.Copy After:=wsPrev
    Set wsNew = ActiveSheet
    wsNew.Name = newName
    
    '--- find relevant labels by text
    Set foundNonTenant = wsNew.Columns("A").Find("Non-Tenant Receipts", , xlValues, xlWhole)
    Set foundUnposted = wsPrev.Columns("A").Find("Unposted Receipts", , xlValues, xlWhole)
    Set foundTotal = wsNew.Columns("A").Find("Total Day's Collections", , xlValues, xlWhole)
    
    If foundNonTenant Is Nothing Or foundUnposted Is Nothing Or foundTotal Is Nothing Then
        MsgBox "Could not locate one or more required labels.", vbExclamation
        Exit Sub
    End If
    
    '--- zero out Non-Tenant Receipts
    foundNonTenant.Offset(0, 1).Value = 0
    
    '--- build formula dynamically
    unpostedRef = "'" & prevName & "'!" & foundUnposted.Offset(0, 1).Address(False, False)
    nonTenantRef = foundNonTenant.Offset(0, 1).Address(False, False)
    
    foundTotal.Offset(0, 1).Formula = "=" & unpostedRef & " + " & nonTenantRef
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "New tab '" & newName & "' created and updated successfully.", vbInformation
End Sub

You might need to adjust it a bit:

• If your labels aren't in column A, change .Columns("A") to the correct column.
• If the label text isn't an exact match (e.g. includes extra spaces or punctuation), you can change the Find parameters to use xlPart instead of xlWhole.
• If “business days” include holidays, you can pass a holiday range into the WorkDay function.

---

If the above response helps answer your question, remember to "Accept Answer" so that others in the community facing similar issues can easily find the solution. Your contribution is highly appreciated.

hth

Marcin