Home > OS >  Use VBA to search for a list a values in column A, and when found update the cell in column B
Use VBA to search for a list a values in column A, and when found update the cell in column B

Time:08-25

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

![enter image description here

Sheet 2

enter image description here

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:

enter image description here

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
  • Related