Create Links (address) after Matching - VBA

nubranger

Board Regular
Joined
Dec 23, 2019
Messages
53
Office Version
  1. 365
Platform
  1. Windows
I have 2 sheets as below: "AE" Sheet and "TC" Sheet. My VBA Code performs 2 matching procedures:

First is single amount matching (1:1) under Sub"match1" which will match the amounts in TC Sheet to AE Sheet within the 3 day range. Amounts matched are highlighted in yellow and a link (address) of the matched amounts in AE Sheet are automatically populated in the column beside "TC" Column of TC Sheet. I have no issue with this matching.

2nd run is combination matching under Sub “combination”. This sub will perform the first loop to identify unmatched amounts by searching for a unhighlighted cell with value under TC Column in “TC” Sheet. Once it finds a unhighlighted cell, the macro will perform the second loop by searching under “AE” column of “AE” Sheet for unhighlighted cells. Once the 2nd loop finds a unhighlighted cell, it will check first if the amount is within the day range then match with the amount identified in the first loop. If the amount found in the second loop doesn’t match with the amount in the first loop, the macro will run the second loop again and searches for the second unhighlighted cell, check if within the day range and combine it with the previous amount found in the second loop then match with the amount found in the first loop and so on…. Amounts matched under this sub are highlighted in green. Now, what I want to achieve is for the macro to create a (sum) link (address) of combined matched amounts beside "TC" column of "TC" sheet.

Basically this is the line from the match1 sub that I am looking for to apply to the 2nd sub:
VBA Code:
     tcRprt.Cells(b, 4).Value = "='AE'!" & aeRprt.Cells(c, 2).Address


Apologize for my poor english.


"AE" Sheet

DayAE
1​
1,420.00​
2​
12,520.00​
3​
4,540.00​
4​
2,130.00​
5​
-​
6​
6,750.00​
7​
2,690.00​
8​
10,430.00​
9​
11,910.00​
10​
-​
11​
4,730.00​
12​
3,040.00​
13​
8,360.00​
14​
-​
15​
3,930.00​
16​
25,610.00​
17​
14,160.00​
18​
17,250.00​
19​
3,390.00​
20​
9,380.00​
21​
8,420.00​
22​
4,350.00​
23​
7,880.00​
24​
15,590.00​
25​
10,010.00​
26​
10,420.00​
27​
12,790.00​
28​
19,210.00​
29​
12,710.00​
30​
9,790.00​


"TC" Sheet
DayTC
1/11/20192,130.00
4/11/201918,480.00
5/11/20192,130.00
7/11/20196,750.00
8/11/20192,690.00
11/11/201922,340.00
12/11/20194,730.00
13/11/20193,040.00
14/11/20198,360.00
18/11/201943,700.00
19/11/201917,250.00
20/11/20193,390.00
21/11/20199,380.00
22/11/20198,420.00
25/11/201927,820.00
26/11/201910,010.00
27/11/201910,420.00
28/11/201912,790.00
29/11/201919,210.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

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
                        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
                            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

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

nubranger

Board Regular
Joined
Dec 23, 2019
Messages
53
Office Version
  1. 365
Platform
  1. Windows
finally Solved.

Just need to add this at the end of e loop
tcRprt.Cells(d, 4).Value = "=SUM('AE'!" & aeRprt.Range("B" & n & ":B" & e).Address & ")"
 

Watch MrExcel Video

Forum statistics

Threads
1,113,774
Messages
5,544,142
Members
410,595
Latest member
Tatum2020
Top