Using VBA, I am trying to search for each value in column A of sheet 1, and match it with column A of sheet 2. If a value is found in sheet 2, update column B to "Yes"
Sheet 1
Sheet 2
So far I have:
Sub UpdateStatus()
Dim list() As Variant
Dim item As Integer
'Assign range to a variable
list = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
'Loop Through Rows
For item = 1 To UBound(list)
'this is where I am stuck
Next item
End Sub
Sheet 2 should look like this afterwards:
CodePudding user response:
Why loop if you can use Excel's engine?
Solution using Excel formulas
Sub Update_Status()
Dim Formula As String
Dim searchRng As Range
Dim valueRng As Range
Dim statusRng As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set valueRng = ws1.Range("A2:A" & LastRow("A", ws1)) ' A2, since you have header
Set searchRng = ws2.Range("A1:A" & LastRow("A", ws2))
Set statusRng = valueRng.Offset(0, 1)
' =IF(COUNTIFS(Sheet2!$A$2:$A$4,Sheet1!A2),"Yes","No")
Formula = "=IF(COUNTIFS(" & _
searchRng.Address(True, True) & "," & _
valueRng.Cells(1, 1).Address(False, False) & _
"),""Yes"",""No"")"
statusRng.Formula = Formula
' In case calculation is turned off
Application.Calculate
' If we prefer hardcoded values
statusRng.Copy
statusRng.PasteSpecial xlPasteValues
Application.CutCopyMode = False ' Flush clipboard
End Sub
Private Function LastRow(Col As String, Ws As Worksheet) As Long
LastRow = Ws.Range(Col & Rows.Count).End(xlUp).Row
End Function
CodePudding user response:
This seems to work:
Sub UpdateStatus()
Dim list() As Variant
Dim item As Integer
Dim FoundCell As Range
Dim SearchValue As String
Dim Sheet2 As Worksheet
Set Sheet2 = Worksheets("Sheet2")
'Assign range to a variable
list = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
'Loop Through Rows
For item = 1 To UBound(list)
SearchValue = list(item, 1)
Set FoundCell = Sheet2.Range("A2:A6").Find(What:=SearchValue)
If Not FoundCell Is Nothing Then
Sheet2.Range("B" & FoundCell.Row).Value = "Yes"
Else
MsgBox (SearchValue & " not found")
End If
Next item
End Sub