VBA - Add column values to array if they meet a certain criterion

[gorem]

Hi everyone,

As always, thanks so much in advance for the assistance. I've been removed from Excel for a while and need a little help with VBA. Essentially I'm trying to do the following:

• Add every value in a column to a new array, ONLY if the value in an adjacent column in each row matches the string "Min"
• Loop through a bunch of cells on other tabs and check if the value in each cell is present in the array. If so, change the cell background color to green.

So far, I seem to be able to create the array of all values in a column, but my IF statement to incorporate my "min" criterion is not working. Thanks in advance!!! Code is below.

Sub ok2()


Dim wb As Workbook
Dim A As Worksheet
Dim G As Worksheet
Dim N As Worksheet
Dim M As Worksheet
Dim P As Worksheet
Dim P_Lastrow As Long


Set wb = ThisWorkbook
Set A = wb.Sheets("Al")
Set G = wb.Sheets("Ge")
Set N = wb.Sheets("Nu")
Set M = wb.Sheets("Me")
Set P = wb.Sheets("Place")


    Dim strArray() As String
    Dim TotalRows As Long
    Dim i As Long


    TotalRows = P.Range("A" & P.Rows.Count).End(xlUp).Row
    ReDim strArray(2 To TotalRows)


    For i = 2 To TotalRows
        If P.Range("V" & i).Value <> "" Then
        strArray(i) = Cells(i, 4).Value
        End If
    Next


    MsgBox "Loaded " & UBound(strArray) & " items!"
    
    Dim cell As Excel.Range
    Dim range1 As Range
    
Set range1 = A.Range("B3:B100")


    For Each cell In range1
    
    If cell.Value <> "" Then
    
        If IsInArray(cell.Value, strArray) Then
        
        With cell.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With


        End If
        
        End If
    
    
    Next cell
    
    
End Sub
    Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

 

[RickXL]

Hi,

Is this what you need to do?

Sub ok2()


Dim wb As Workbook
Dim A As Worksheet
Dim G As Worksheet
Dim N As Worksheet
Dim M As Worksheet
Dim P As Worksheet
Dim P_Lastrow As Long


Set wb = ThisWorkbook
Set A = wb.Sheets("Al")
Set G = wb.Sheets("Ge")
Set N = wb.Sheets("Nu")
Set M = wb.Sheets("Me")
Set P = wb.Sheets("Place")


    Dim strArray() As String
    Dim TotalRows As Long
    Dim i As Long
[COLOR=#ff0000][/COLOR]

    TotalRows = P.Range("A" & P.Rows.Count).End(xlUp).Row
    ReDim strArray(2 To TotalRows)


    For i = 2 To TotalRows
        If P.Range("V" & i).Value <> "" [COLOR=#ff0000][B]And P.Range("W" & i)="Min"[/B][/COLOR] Then
        strArray(i) = Cells(i, 4).Value
        End If
    Next


    MsgBox "Loaded " & UBound(strArray) & " items!"
    
    Dim cell As Excel.Range
    Dim range1 As Range
    
Set range1 = A.Range("B3:B100")


    For Each cell In range1
    
    If cell.Value <> "" Then
    
        If IsInArray(cell.Value, strArray) Then
        
        With cell.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With


        End If
        
        End If
    
    
    Next cell
    
    
End Sub
    Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function