I have a list of reference #s that I am matching to 2 data sets and if a match is found, the macro will pull certain fields over.

For the 1st database I don't have multiple matches by reference # but in the second database I have multiple matches by reference # and I would like to pull only the most recent entries (preferably 2 or 3).

The code right now will put the data in specific columns; for database 2 in Column H,I,J,K. In case there are up to 3 matches by reference # I would like the code to continue and add the second match in Column L,M,N,O and so on for the third.

The code is below. While I was searching I was wondering if this code might help sorting by date?

- Option Explicit
- Public Sub TestMe()
- Dim dateRanges As Range Set dateRanges = Range("D1:D11")
- Dim mn As Variant With Application
- mn = .Match(.Min(dateRanges), dateRanges, 0) End With
- MsgBox Range("E" & mn).Value2
- End Sub

**this is the code i have right that is working for simple match**

- Sub HB_IPT_Rate_Comparison()
- Dim KeyCells As Range
- Dim Sheet1, Sheet2, sheet3 As Worksheet
- Dim CellChanged As Integer
- Dim Path, File As String
- Dim LastRow, LastData As Long
- Dim Found As Boolean
- On Error GoTo Handle
- Set Sheet1 = Sheets("Comparison Report")
- Sheet1.Range("H1").Clear
- If Sheet1.Range("H1").Value = "" Then
- Sheet1.Range("H1").Value = 0
- CellChanged = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
- End If
- If Sheet1.Cells(Rows.Count, "C").End(xlUp).Row > Sheet1.Range("H1").Value Then
- CellChanged = Sheet1.Range("H1").Value + 1
- '1st Database Match "CPK"
- Set Sheet2 = Sheets("CPK")
- LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
- LastData = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
- For i = 1 To LastRow
- On Error Resume Next
- If Sheet1.Range("C" & CellChanged).Value = "" Then GoTo Nextstep
- If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then
- Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value 'Sum of HB CWGT (KG)
- Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value 'Sum of MB CWGT (KG)
- Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value 'Achiev CPK
- Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("H" & i).Value 'Density
- Found = True
- End If
- If Found = True Or i = LastRow Then
- If CellChanged = LastData Then
- Exit For
- End If
- If Found = True Then
- Found = False
- Nextstep:
- CellChanged = CellChanged + 1
- End If
- i = 0
- End If
- Next i
- '2nd Database Match "Orbit"
- Set sheet3 = Sheets("Orbit")
- CellChanged = Sheet1.Range("H1").Value + 1
- LastRow = sheet3.Cells(Rows.Count, "A").End(xlUp).Row
- LastData = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
- For i = 1 To LastRow
- On Error Resume Next
- If Sheet1.Range("C" & CellChanged).Value = "" Then GoTo Nextstep2
- If Sheet1.Range("C" & CellChanged).Value = sheet3.Range("A" & i) Then
- Sheet1.Range("H" & CellChanged).Value = sheet3.Range("B" & i).Value 'Customer
- Sheet1.Range("I" & CellChanged).Value = sheet3.Range("G" & i).Value 'Rate Val start
- Sheet1.Range("J" & CellChanged).Value = sheet3.Range("AG" & i).Value 'ATA All in
- Sheet1.Range("K" & CellChanged).Value = sheet3.Range("R" & i).Value 'Special Remarks
- Found = True
- End If
- If Found = True Or i = LastRow Then
- If CellChanged = LastData Then
- Exit For
- End If
- If Found = True Then
- Found = False
- Nextstep2:
- CellChanged = CellChanged + 1
- End If
- i = 0
- End If
- Next i
- Sheet1.Range("H1").Value = CellChanged
- End If
- Exit Sub
- Handle:
- MsgBox ("Error")
- End Sub

Display More