SUM of amounts in one report to match with SUM of amounts in other report VBA

nubranger

Board Regular
Joined
Dec 23, 2019
Messages
53
Office Version
  1. 365
Platform
  1. Windows
I have 2 sheets - "AE" Sheet (representing "Day" & "AE" columns below) and "TC" Sheet (rep "Date" & "TC" columns Below). I need to do matching of both sheets. With the VBA code below, I was able to perform the ff matching procedures 1.) Single amount matching 1:1 and 2.) Single to Combination (sum of amounts) matching. Now, my problem is there is a new matching event that is not captured by my code. When I sum up the bold amounts in TC sheet below, I can find the match in AE sheet which is equivalent to the bold amounts below. Same with the amounts in Bold Italic amounts below. The match should fall within the 3 day range.

Not so sure on how will I code this. My codes are one way matching meaning my "TC" sheet is my main report and the main loop is based on the number of rows in the "TC" sheet.



DayAEDateTC
1​
1,420.00​
2/11/20192,130.00
2​
12,520.00​
4/11/201918,480.00
3​
4,540.00​
5/11/2019776.00
4​
2,130.00​
5/11/2019350.00
5​
-​
5/11/20192,130.00
5​
879.00
7/11/20196,750.00
5​
2,377.00
8/11/20192,690.00
6​
6,750.00​
11/11/201922,340.00
7​
2,690.00​
12/11/20194,730.00
8​
10,430.00​
13/11/20193,040.00
9​
11,910.00​
13/11/20192,004.00
10​
-​
14/11/20191,686.00
11​
4,730.00​
14/11/20198,360.00
12​
3,040.00​
18/11/201943,700.00
13​
8,360.00​
14​
-​
15​
3,257.00
15​
433.00
15​
3,930.00​
16​
25,610.00​
17​
14,160.00​


VBA Code:
Option Explicit

'Declare
Dim aeRprt As Worksheet
Dim tcRprt As Worksheet
Dim aeRow As Long
Dim tcRow As Long
Dim Search1 As Variant
Dim Search2 As Variant
Dim Search3 As Variant
Dim Search4 As Variant
Dim currSum As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim f As Long
Dim g As Long
Sub main()

Call clearcolor
Call match1
Call combination

End Sub

Sub clearcolor()

'Set Sheets
Set aeRprt = Sheets("AE")
Set tcRprt = Sheets("TC")

'Define last row count
aeRow = aeRprt.Cells(Rows.Count(), 1).End(xlUp).Row
tcRow = tcRprt.Cells(Rows.Count(), 1).End(xlUp).Row

Range(aeRprt.Cells(2, 2), aeRprt.Cells(aeRow, 2)).Interior.Color = xlNone

Range(tcRprt.Cells(2, 2), tcRprt.Cells(tcRow, 2)).Interior.Color = xlNone

Range(tcRprt.Cells(2, 4), tcRprt.Cells(tcRow, 4)).ClearContents

End Sub


Private Sub match1()
    
    'Set Sheets
    Set aeRprt = Sheets("AE")
    Set tcRprt = Sheets("TC")
    
    'Define last row count
    aeRow = aeRprt.Cells(Rows.Count(), 1).End(xlUp).Row
    tcRow = tcRprt.Cells(Rows.Count(), 1).End(xlUp).Row
    
    'Get # of days from the date
    For a = 2 To tcRow
        tcRprt.Cells(a, "C") = Split(tcRprt.Cells(a, "A"), "/")(0)
    Next a
    
    '1:1 Matching
    For b = 2 To tcRow
        Set Search1 = tcRprt.Cells(b, 2)
        Set Search2 = tcRprt.Cells(b, 3)
        For c = 2 To aeRow
            If aeRprt.Cells(c, 2) = Search1 Then
                If Search2 - aeRprt.Cells(c, 1) >= 0 And Search2 - aeRprt.Cells(c, 1) <= 3 Then
                    If aeRprt.Cells(c, 2).Interior.Color = 16777215 And Search1.Interior.Color = 16777215 Then
                        aeRprt.Cells(c, 2).Interior.Color = 65535
                        Search1.Interior.Color = 65535
                        'Create link to matched amount
                        tcRprt.Cells(b, 4).Value = "='AE'!" & aeRprt.Cells(c, 2).Address
                        Exit For
                    End If
                End If
            End If
        Next c
    Next b
    
End Sub

Private Sub combination()
    
    'Set Sheets
    Set aeRprt = Sheets("AE")
    Set tcRprt = Sheets("TC")
    
    Dim n As Long
    
    'Define last row count
    aeRow = aeRprt.Cells(Rows.Count(), 1).End(xlUp).Row
    tcRow = tcRprt.Cells(Rows.Count(), 1).End(xlUp).Row
    
    'Loop to sum non-higlighted cells to match with TC Sheet within 3 days range
    For d = 2 To tcRow
        
        Set Search3 = tcRprt.Cells(d, 2)
        Set Search4 = tcRprt.Cells(d, 3)
        
        'If a Cell in TC Sheet is not highlighted Loop to e
        If Search3.Interior.Color = 16777215 Then
            
            'Searches and stores non-highlighted cells and match with the cell identified in Loop d
            For e = 2 To aeRow
                If aeRprt.Cells(e, 2).Interior.Color = 16777215 Then
                    If Search3 - aeRprt.Cells(e, 1) >= 0 And Search4 - aeRprt.Cells(e, 1) <= 3 Then
                        If n = 0 Then n = e
                        currSum = currSum + aeRprt.Cells(e, 2).Value
                        If currSum = Search3 Then
                            Search3.Interior.Color = 5296274
                            aeRprt.Range("B" & n & ":B" & e).Interior.Color = 5296274
                            'Create link to matched amounts
                            tcRprt.Cells(d, 4).Value = "=SUM('AE'!" & aeRprt.Range("B" & n & ":B" & e).Address & ")"
                            Exit For
                        End If
                    End If
                End If
            Next e
            
            currSum = 0
            n = 0
            
        End If
 
    Next d
    
End Sub
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Watch MrExcel Video

Forum statistics

Threads
1,114,442
Messages
5,547,945
Members
410,820
Latest member
Prepost
Top