Hi Experts,
I want to make this macro Lr as dynamic
Code:
Sub STEP4()
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx")
Dim Ws1 As Worksheet, WS2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set WS2 = Wb2.Worksheets.Item(4)
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
Dim rngSrch As Range: Set rngSrch = WS2.Range("B1:B" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("I2:I" & 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
Thnx For the Help
Code:
Sub STEP5()
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(2)
Dim Lr1 As Long, Lr2 As Long:
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & 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
Else
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
End If
Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub
I changed the lr for this problem Plz see is it perfect?
Both macros are givng perfect Result But u have recommended it will work sometimes & may be sometimes it will not work thats y i posted this question
Code:
Sub STEP6()
Dim Wbm As Workbook: Set Wbm = ThisWorkbook
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 Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\WolfieeeStyle\9.15\Files\Error.xlsx")
Set Ws2 = Wb2.Worksheets.Item(1)
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets.Item(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
Code:
Sub STEP9()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets(1)
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\WolfieeeStyle\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
Bookmarks