Posts by holycow

Sub temp()
Dim rng As Range, r As Long, c As Long, z As Long
Sheets("Matched").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "to correct Invoice No. & Date"
r = [a1].CurrentRegion.Rows.Count - 1: c = [a1].CurrentRegion.Columns.Count
Set rng = [a2].Resize(r, c)
r = r + 1
With rng
With .Columns(11)
.Value = "=IF(COUNTIFS($C$2:$C$" & r & ",$C2,$B$2:$B$" & r & ",""<>""&$B2,$E$2:$E$" & _
r & ",$E2)=0,""Invoice No. Mismatch"","""")&IF(COUNTIFS($C$2:$C$" & r & _
",$C2,$B$2:$B$" & r & ",""<>""&$B2,$F$2:$F$" & r & ",$F2)=0,""Date Mismatch"","""")" & _
"&IF(COUNTIFS($C$2:$C$" & r & ",$C2,$B$2:$B$" & r & ",""<>""&$B2,$E$2:$E$" & _
r & ",$E2,$F$2:$F$" & r & ",$F2)>0,""zzz"","""")"
.Value = .Value
.AutoFit
End With
.Sort Key1:=.Columns(11), Order1:=xlAscending, Key2:=.Columns(3), Order2:=xlAscending, Orientation:=xlSortColumns
z = .Columns(11).Find("zzz").Row
End With
Rows(z & ":" & r).Delete
End Sub

Private Sub A4_Copy_Rename_MatchedSheet()
'
Dim StartTime   As Double
StartTime = Timer                                                                           ' Start the stop watch
'
Dim FirstMatch                  As Long
Dim DestinationRemarksColumn    As String
Dim LastColumn                  As String
'
DestinationRemarksColumn = "K"                                                                                  ' <--- Set this to the 'Remarks' column letter
'
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
LastColumn = Split(Cells(Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column).Address, "$")(1)   ' LastColumn Letter Used In 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,""zzz"","""")"                                   '   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
Range("A2:" & LastColumn & Range("A" & Rows.Count).End(xlUp).Row).Sort _
Key1:=Range(DestinationRemarksColumn & "2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order1:=xlAscending, Header:=xlNo                          ' Sort GSTIN then Invoice Column lowest to highest
'
FirstMatch = Columns(DestinationRemarksColumn).Find(what:="zzz", After:=Range(DestinationRemarksColumn & "1")).Row  ' Find first cell in DestinationRemarksColumn that = 'Matched
'
Rows(FirstMatch & ":" & LastRow).Delete                                                                         ' Ddelete the 'Matched' rows
'
Debug.Print "Copy_Rename_MatchedSheet completed in " & Timer - StartTime & " seconds."
'
End Sub