make Lr dynamics of the macro

[zyxw1234]

Hi Experts,
I am looking to modify this macro as per my needs

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:UsersWolfieeeStyleDesktopWolfieeeStyle9.15FilesError.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
    If ActiveSheet.Cells(1, 1) = "" Then Exit Sub
    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

2 changes are required
1)Make Lr dynamics
2)If ActiveSheet.Cells(1, 1) = "" Then Exit Sub (this line exits if condition not mets or if it has blank sheet or may be xyz reason, it is doing correct But after exit It should close all the file excluding the macro placed file

[HansV]

1) Remove

: Let lr1 = 5000: lr2 = 5000

Insert the following below the line that sets ws2:

l1 = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row

and insert a similar line for lr2.

2) Change the line

Code: Select all

    If ActiveSheet.Cells(1, 1) = "" Then Exit Sub

to

Code: Select all

    If ActiveSheet.Cells(1, 1) = "" Then
         wb1.Close SaveChanges:=False
         wb2.Close SaveChanges:=False
        Exit Sub
    End If

[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 = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row
Let lr2 = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row

Set wb1 = Workbooks.Open("C:\Users\**I've been banned**\Desktop\1.xls")
Set ws1 = wb1.Worksheets(1)
Set wb2 = Workbooks.Open("C:\Users\**I've been banned**\Desktop\**I've been banned**\9.15\Files\Error.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
    If ActiveSheet.Cells(1, 1) = "" Then
         wb1.Close SaveChanges:=False
         wb2.Close SaveChanges:=False
        Exit Sub
    End If
    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

I changed plz see HansV Sir
Is everything Perfect?

[HansV]

It won't work that way. You assign a value to lr1 and lr2 BEFORE you set ws1 and ws2. So you will get an error message.

Please read my previous reply more carefully.

[zyxw1234]

Code: Select all

Sub STEP6()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Set wb1 = Workbooks.Open("C:\Users\**I've been banned**\Desktop\1.xls")
Set ws1 = wb1.Worksheets(1)
Set wb2 = Workbooks.Open("C:\Users\**I've been banned**\Desktop\**I've been banned**\9.15\Files\Error.xlsx")
Set ws2 = wb2.Worksheets(1)
Dim lr1 As Long, lr2 As Long
Let lr1 = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row
Let lr2 = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row

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
    If ActiveSheet.Cells(1, 1) = "" Then
         wb1.Close SaveChanges:=False
         wb2.Close SaveChanges:=False
        Exit Sub
    End If
    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

Awesome HansV Sir
Thnx Alot For helping me in solving this problem Sir
Macro is working Awesome
Thnx for guiding me in modifying the same