How to properly write this vba code in excel-CodePudding

I am working a spreadsheet in excel and I am stumped on how to accomplish the following:

I need check the value in every cell in column “a” and if it equals a specific manually entered text then check the value in the same cell in column “d”. If column “d” equals and one of 4 possibilities, then I need to change the value in column F to 0. Otherwise leave F with the value that was manually entered there.

My VB coding is very rusty but it might flow something like this:

    If (value in any cell in column a) = "x" and
          (value in same cell in column d) = "text 1" OR
          (value in same cell in column d) = "text 2" OR
          (value in same cell in column d) = "text 3" OR
          (value in same cell in column d) = "text 4"
    Then
          (value in same cell in column F) = 0
    Endif

In other words, if an “x” is entered in column a, and one of the 4 texts appear in the same cell in column d then the value in the same cell in column f changes to 0 from the previously manually entered value.

Thank you

CodePudding user response：

Match Data (`For Each`, `Application.Match`)

Option Explicit

Sub MatchData()
    
    ' Worksheet
    Const wsName As String = "Sheet1"
    ' Source
    Const sCol As String = "A"
    Const sCriteria As String = "X"
    ' Criteria
    Const cCol As String = "D"
    Const cCriteriaList As String = "Text1,Text2,Text3,Text4"
    ' Destination
    Const dCol As String = "F"
    Const dCriteria As Long = 0
    ' All
    Const fRow As Long = 2
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
    If lRow < fRow Then Exit Sub ' no data in column range
    Dim rCount As Long: rCount = lRow - fRow   1
    Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
    
    Dim crg As Range: Set crg = srg.EntireRow.Columns(cCol)
    Dim drg As Range: Set drg = srg.EntireRow.Columns(dCol)
    
    Dim cCriteria() As String: cCriteria = Split(cCriteriaList, ",")
    
    Dim sCell As Range
    Dim cMatch As Variant
    Dim r As Long
    
    For Each sCell In srg.Cells
        r = r   1
        If StrComp(CStr(sCell.Value), sCriteria, vbTextCompare) = 0 Then
            cMatch = Application.Match(CStr(crg.Cells(r).Value), cCriteria, 0)
            If IsNumeric(cMatch) Then
                drg.Cells(r).Value = dCriteria
            End If
        End If
    Next sCell
    
    MsgBox "Data matched.", vbInformation
    
End Sub

Match Data (For Each, Application.Match)

Match Data (`For Each`, `Application.Match`)