I have had this working well until it grew so large it runs for a long time. What I would like it to do is:
Take the values on sheets (3_Create Scratch") range (I10:I109) and check for exact match on Sheets ("On Premise") range (A2:A10500) when an exact match is found remove the value from Sheets ("On Premise") and paste those values into sheets ("Excess") (A2:A2000) in the next available cell at bottom of the column. If no match is found move it to sheet ("Excess") anyways, Then clean up both sheets by sorting columns A to Z and removing any blanks. I hope there is a way to improve this. Thank you all in advance!
Sub MovetoExcess4()
Sheet4.Unprotect Password:="password"
Sheet6.Unprotect Password:="password"
Sheet7.Unprotect Password:="password"
Sheet8.Unprotect Password:="password"
Dim s3Rng As Range, c As Range, rngFound As Range
Dim iRow As Long, aRow As Long
iRow = Sheets("3_Create Scratch").Cells(Rows.Count, 9).End(xlUp).Row
aRow = Sheets("On Premise").Cells(Rows.Count, 1).End(xlUp).Row
Set s3Rng = Sheets("3_Create Scratch").Range("I10:I" & iRow)
For Each c In s3Rng
With Sheets("On Premise")
Set rngFound = Sheets("On Premise").Range("A2:A" & aRow).Find(What:=c, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngFound Is Nothing Then
rngFound.Cut Sheets("Excess").Range("A" & Rows.Count).End(xlUp)(2)
Else
'
End If
End With
Next
With Sheets("Excess").Columns("A")
.Sort key1:=.Cells(2, 1), order1:=xlAscending, Header:= _
xlYes, Orientation:=xlTopToBottom
End With
s3Rng = ""
Sheet4.Protect Password:="password"
Sheet6.Protect Password:="password"
Sheet7.Protect Password:="password"
Sheet8.Protect Password:="password"
'Range("A1").Select
'End With
'
End Sub
Take the values on sheets (3_Create Scratch") range (I10:I109) and check for exact match on Sheets ("On Premise") range (A2:A10500) when an exact match is found remove the value from Sheets ("On Premise") and paste those values into sheets ("Excess") (A2:A2000) in the next available cell at bottom of the column. If no match is found move it to sheet ("Excess") anyways, Then clean up both sheets by sorting columns A to Z and removing any blanks. I hope there is a way to improve this. Thank you all in advance!
Sub MovetoExcess4()
Sheet4.Unprotect Password:="password"
Sheet6.Unprotect Password:="password"
Sheet7.Unprotect Password:="password"
Sheet8.Unprotect Password:="password"
Dim s3Rng As Range, c As Range, rngFound As Range
Dim iRow As Long, aRow As Long
iRow = Sheets("3_Create Scratch").Cells(Rows.Count, 9).End(xlUp).Row
aRow = Sheets("On Premise").Cells(Rows.Count, 1).End(xlUp).Row
Set s3Rng = Sheets("3_Create Scratch").Range("I10:I" & iRow)
For Each c In s3Rng
With Sheets("On Premise")
Set rngFound = Sheets("On Premise").Range("A2:A" & aRow).Find(What:=c, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngFound Is Nothing Then
rngFound.Cut Sheets("Excess").Range("A" & Rows.Count).End(xlUp)(2)
Else
'
End If
End With
Next
With Sheets("Excess").Columns("A")
.Sort key1:=.Cells(2, 1), order1:=xlAscending, Header:= _
xlYes, Orientation:=xlTopToBottom
End With
s3Rng = ""
Sheet4.Protect Password:="password"
Sheet6.Protect Password:="password"
Sheet7.Protect Password:="password"
Sheet8.Protect Password:="password"
'Range("A1").Select
'End With
'
End Sub