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.
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.
Day | AE | Date | TC | |
1 | 1,420.00 | 2/11/2019 | 2,130.00 | |
2 | 12,520.00 | 4/11/2019 | 18,480.00 | |
3 | 4,540.00 | 5/11/2019 | 776.00 | |
4 | 2,130.00 | 5/11/2019 | 350.00 | |
5 | - | 5/11/2019 | 2,130.00 | |
5 | 879.00 | 7/11/2019 | 6,750.00 | |
5 | 2,377.00 | 8/11/2019 | 2,690.00 | |
6 | 6,750.00 | 11/11/2019 | 22,340.00 | |
7 | 2,690.00 | 12/11/2019 | 4,730.00 | |
8 | 10,430.00 | 13/11/2019 | 3,040.00 | |
9 | 11,910.00 | 13/11/2019 | 2,004.00 | |
10 | - | 14/11/2019 | 1,686.00 | |
11 | 4,730.00 | 14/11/2019 | 8,360.00 | |
12 | 3,040.00 | 18/11/2019 | 43,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