I have this code but it only pastes against the first matching row and not all matching rows, my code assumes the item i am trying to match is unique!
Any help much appreciated
Any help much appreciated
Code:
Option Explicit
Sub ReportMatcher()
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim rngDest As Range
Dim rngSource As Range
Dim rng As Range
Dim rowMatch As Variant
Set wsDest = ActiveSheet
If Not Application.Dialogs(xlDialogActivate).Show Then
Exit Sub
End If
Application.ScreenUpdating = False
Set wsSource = ActiveSheet
With wsDest
Set rngDest = .Range("D:D")
End With
With wsSource
Set rngSource = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each rng In rngSource.Cells
If Len(rng.Value) > 0 Then
rowMatch = Application.Match(rng.Value, rngDest, 0)
If IsNumeric(rowMatch) Then
wsDest.Range("T" & rowMatch).Value = wsSource.Range("B" & rng.Row).Value
wsDest.Range("U" & rowMatch).Value = wsSource.Range("D" & rng.Row).Value
End If
End If
Next rng
Application.ScreenUpdating = True
MsgBox "Order Numbers Added", vbInformation
End Sub