condition not matched then delete entire row(Macro Correction)

[zyxw1234]

Code: Select all

Sub STEP6()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
Set Wb1 = Workbooks.Open("C:UsersWolfieeeStyleDesktop1.xls")
Set Ws1 = Wb1.Worksheets(1)
Set Wb2 = Workbooks.Open("C:UsersWolfieeeStyleDesktopFilesError.xlsx")
Set Ws2 = Wb2.Worksheets(1)

Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")

Dim Cnt As Long
    For Cnt = Lr2 To 1 Step -1
    Dim MtchedCel As Variant
     Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
        If Not MtchedCel Is Nothing Then
         rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
        Else
        End If
        
    Next Cnt
 Wb1.Close SaveChanges:=True
 Wb2.Close SaveChanges:=True
End Sub

This code has limitation of LR1=5000 & LR2= 5000(plz remove the limitations of this macro)
& one more issue is there with this macro
I am sending the sample file plz run the macro & see the output
If error.xlsx is blank sheet then it is giving something different output plz see



Thnx for the help

https://excelfox.com/forum/showthread.p ... #post14693

[HansV]

See condition not matched then delete entire row(Macro Correction)