Sub Copy_Rename_MatchedSheet()
'
Dim FirstMatch As Long
Dim DestinationRemarksColumn As String
Dim LastColumn As String
'
DestinationRemarksColumn = "J" ' <--- Set this to the 'Remarks' column letter
LastColumn = "N" ' <--- Set this to the last column letter used in the sheet
'
Sheets("Matched").Copy after:=Sheets(Sheets.Count) ' Copy/add worksheet
ActiveSheet.Name = "to correct Invoice No. & Date" ' Rename the new sheet
'
LastRow = Range("A" & Rows.Count).End(xlUp).Row ' Get LastRow used of new sheet
'
With Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & LastRow)
.Formula = "=IF(COUNTIFS($C$2:$C$" & LastRow & ",$C2,$B$2:$B$" & LastRow & ",""<>""&$B2,$E$2:$E$" & _
LastRow & ",$E2)=0,""Invoice No. Mismatch"","""")&IF(COUNTIFS($C$2:$C$" & LastRow & _
",$C2,$B$2:$B$" & LastRow & ",""<>""&$B2,$F$2:$F$" & LastRow & ",$F2)=0,""Date Mismatch"","""")" & _
"&IF(COUNTIFS($C$2:$C$" & LastRow & ",$C2,$B$2:$B$" & LastRow & ",""<>""&$B2,$E$2:$E$" & _
LastRow & ",$E2,$F$2:$F$" & LastRow & ",$F2)>0,""Matched"","""")" ' Formula to write to the range
.Copy ' Copy the formula range
.PasteSpecial xlPasteValues ' Paste just the values back to range
Application.CutCopyMode = False ' Clear clipboard & 'marching ants' around copied range
End With
'
Range(DestinationRemarksColumn & "1").EntireColumn.AutoFit ' Adjust the width of the DestinationRemarksColumn
'
Range("A2:" & LastColumn & Range("A" & Rows.Count).End(xlUp).Row).Sort _
Key1:=Range(DestinationRemarksColumn & "2"), Order1:=xlAscending, Header:=xlNo ' Sort Remarks Column lowest to highest
'
FirstMatch = Columns(DestinationRemarksColumn).Find(what:="Matched", after:=Range(DestinationRemarksColumn & "1")).Row ' Find first cell in DestinationRemarksColumn that = 'Matched
'
Rows(FirstMatch & ":" & LastRow).Delete ' Delete the 'Matched' rows
End Sub