Alright, let's solve this UPS invoice automation problem you're facing. Handling regular cost center matches is straightforward, but the "Service Fee" row requirement needs a bit of extra work—here's a complete VBA solution that covers both scenarios, with clear customization tips:

Core Logic Breakdown #

First, we'll do a pass through the invoice to collect and tally costs per account + cost center (ignoring Service Fee rows since they don't have their own cost center). Then, we'll loop through the invoice again:

• For regular rows: Use your existing cell-matching logic to assign cost centers
• For "Service Fee" rows: Look up the account's highest-cost cost center from our tally and assign it

Complete VBA Code #

Sub PopulateUPSCostCenters()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim accountCostData As Object ' Nested dictionary: Account -> {CostCenter: TotalCost}
    Dim i As Long
    Dim currentAccount As String
    Dim currentDescription As String
    Dim currentCost As Double
    Dim maxCost As Double
    Dim topCostCenter As String
    
    ' --------------------------
    ' Customize these values to match your invoice's structure
    ' --------------------------
    Set ws = ThisWorkbook.Worksheets("UPS Invoice") ' Replace with your sheet name
    Const ACCOUNT_COL As String = "A"       ' Column with account numbers
    Const DESC_COL As String = "B"          ' Column with line item description
    Const COST_COL As String = "C"          ' Column with line item cost
    Const COST_CENTER_COL As String = "D"   ' Column to populate cost center
    Const SERVICE_FEE_TEXT As String = "Service Fee"
    
    ' Get last row with data
    lastRow = ws.Cells(ws.Rows.Count, ACCOUNT_COL).End(xlUp).Row
    
    ' Initialize dictionary to track account-cost center totals
    Set accountCostData = CreateObject("Scripting.Dictionary")
    
    ' --------------------------
    ' First pass: Tally costs per account + cost center
    ' --------------------------
    For i = 2 To lastRow ' Skip header row (adjust if your header is on a different row)
        currentAccount = Trim(ws.Cells(i, ACCOUNT_COL).Value)
        currentDescription = Trim(ws.Cells(i, DESC_COL).Value)
        currentCost = ws.Cells(i, COST_COL).Value
        
        ' Skip Service Fee rows for tallying
        If currentDescription <> SERVICE_FEE_TEXT Then
            Dim existingCostCenter As String
            existingCostCenter = Trim(ws.Cells(i, COST_CENTER_COL).Value)
            
            ' Create nested dictionary for the account if it doesn't exist
            If Not accountCostData.Exists(currentAccount) Then
                accountCostData(currentAccount) = CreateObject("Scripting.Dictionary")
            End If
            
            ' Add to or update the cost center's total cost
            If accountCostData(currentAccount).Exists(existingCostCenter) Then
                accountCostData(currentAccount)(existingCostCenter) = accountCostData(currentAccount)(existingCostCenter) + currentCost
            Else
                accountCostData(currentAccount)(existingCostCenter) = currentCost
            End If
        End If
    Next i
    
    ' --------------------------
    ' Second pass: Populate cost centers
    ' --------------------------
    For i = 2 To lastRow
        currentAccount = Trim(ws.Cells(i, ACCOUNT_COL).Value)
        currentDescription = Trim(ws.Cells(i, DESC_COL).Value)
        
        If currentDescription = SERVICE_FEE_TEXT Then
            ' Find the cost center with the highest total cost for this account
            maxCost = 0
            topCostCenter = ""
            
            If accountCostData.Exists(currentAccount) Then
                Dim costCenter As Variant
                For Each costCenter In accountCostData(currentAccount).Keys
                    If accountCostData(currentAccount)(costCenter) > maxCost Then
                        maxCost = accountCostData(currentAccount)(costCenter)
                        topCostCenter = costCenter
                    End If
                Next costCenter
            End If
            
            ' Assign the top cost center (or flag if none found)
            If topCostCenter <> "" Then
                ws.Cells(i, COST_CENTER_COL).Value = topCostCenter
            Else
                ws.Cells(i, COST_CENTER_COL).Value = "⚠️ No Matching Cost Center"
                ws.Cells(i, COST_CENTER_COL).Interior.Color = RGB(255, 204, 204) ' Highlight missing data
            End If
        Else
            ' --------------------------
            ' Insert your existing regular row logic here
            ' Example: VLOOKUP from a mapping table
            ' ws.Cells(i, COST_CENTER_COL).Value = Application.VLookup( _
            '     currentAccount, _
            '     ThisWorkbook.Worksheets("CostCenterMap").Range("A:B"), _
            '     2, _
            '     False _
            ' )
            ' --------------------------
        End If
    Next i
    
    MsgBox "Cost center population complete!", vbInformation
End Sub

Customization & Tips #

• Column/Sheet Adjustments: The top section of the code has constants for column letters and sheet names—update these to match your actual invoice layout.
• Regular Row Logic: Replace the commented-out section with your existing cell-matching code (like VLOOKUP, index-match, or another dictionary lookup).
• Error Handling: If a Service Fee row has no matching account data, it will be highlighted in light red with a warning message—easy to spot and fix manually.
• Performance: Using dictionaries makes this solution fast even for large invoices (hundreds/thousands of rows) compared to looping through ranges repeatedly.

How to Implement #

1. Open your UPS invoice Excel file.
2. Press Alt + F11 to open the VBA Editor.
3. Right-click your workbook in the Project Explorer > Insert > Module.
4. Paste the code into the new module.
5. Adjust the constants at the top to match your invoice's structure.
6. Run the macro by pressing F5, or from Excel's Developer tab > Macros > select PopulateUPSCostCenters > Run.

内容的提问来源于stack exchange，提问作者Ian Webster