I have searched and found a number of posts that are similar for instance
Look for values from sheet A in sheet B, and then do function in corresponding sheet B cell and For each Loop Will Not Work Search for Value On one Sheet and Change Value on another Sheet
While each of these address some aspect of my goal they are not quite it. I have 3 sheets, sheet1 - 3, I want to search and match in sheets1 - 2 on columns A and B, if a match is found or not found in column B check value in column A to copy to sheet3 or not.
This is what I have so far using Office 2016.
Public Sub SeekFindCopyTo()
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim tempVal As String
lastRow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
lastRow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
For sRow = 4 To lastRow1
Debug.Print ("sRow is " & sRow)
tempVal = Sheets("Sheet1").Cells(sRow, "B").Text
For tRow = 4 To lastRow2
Debug.Print ("tRow is " & tRow)
TestVal = Sheets("Sheet2").Cells(tRow, "B")
Operations = Sheets("Sheet2").Cells(tRow, "A")
If Sheets("SAP_XMATTERS").Cells(tRow, "B") = tempVal Then
Operations = Sheets("Sheet2").Cells(tRow, "A")
Debug.Print ("If = True tempVal is " & tempVal)
Debug.Print ("If = True TestVal is " & TestVal)
Debug.Print ("If = True Operaitons is " & Operations)
If Operations = "REMOVE" Then
Sheets("Sheet2").Range("A" & tRow).EntireRow.Copy
Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell
'Sheets("Sheet2").Rows(tRow).Delete
Else
'Sheets("Sheet2").Rows(tRow).Delete
End If
End If
Next tRow
Next sRow
End Sub
The code works well enough but the catch is that I am looking for a match in B:B between Sheets 1&2 if match I want to check the adjacent cell in A:A for the string REMOVE if it is REMOVE then copy entire row to sheet3. Here's the problem I also want to know if there is not a match in B:B between Sheets 2 & 1 with the string PROCESS in adjacent cell if so copy entire row to sheet3. I can do either option in separate subs but cannot make it work in one pass.
Your help would be appreciated even if it is along the lines of "you can't do that" ;-)
TIA
Bob
A total re-write using .Find did the trick.
Sub SeekFindCopy()
Dim sourceValue As Variant
Dim resultOfSeek As Range
Dim targetRange As Range
LastRow = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
Set targetRange = Sheets("Sheet2").Range("B:B")
For sourceRow = 4 To LastRow
Debug.Print ("sRow is " & sRow)
sourceValue = Sheets("Sheet1").Range("B" & sRow).Value
Set resultOfSeek = targetRange.Find(what:=sourceValue, After:=targetRange(1))
'Debug.Print (sourceValue)
Operations = Sheets("Sheet1").Cells(sRow, "A")
If resultOfSeek Is Nothing Then
'Debug.Print ("Operations is " & Operations)
If Operations = "PROCESS" Then
Sheets("Sheet1").Range("A" & sRow).EntireRow.Copy
Sheets("UpLoad").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell
'Sheets("Sheet1").Rows(tRow).Delete
End If
Else
'Debug.Print ("Operations is " & Operations)
If Operations = "REMOVE" Then
Sheets("Sheet1").Range("A" & sRow).EntireRow.Copy
Sheets("UpLoad").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell
'Sheets("Sheet1").Rows(tRow).Delete
End If
End If
Next sourceRow
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.