Array To Check Column For Matched Value-CodePudding

I would like to seek your help for my issue:

I would like to check if the row value in Column Q of Workbook A is "WIN".

If yes, then return 1 in the corresponding row in Column BL of Workbook A.

If no, then return 0 in the corresponding row in Column BL of Workbook A.

I have applied a VBA-based array to carry out the check but unfortunately, I am only getting 1, not 0...

My (non-working) code is below:

Dim ws As Worksheet
Dim j, LastRowOutcomeCleaned As Long
Dim arrQ, arrBL As Variant
Dim answer, found As Range
  
Set ws = Workbooks("A.xlsx").Sheets(2)
LastRow = ws.Range("Q" & Rows.Count).End(xlUp).Row

arrQ = ws.Range("Q2:Q" & LastRow).Value 
arrBL = ws.Range("BL2:BL" & LastRow).Value 

ReDim arrBL(1 To UBound(arrQ), 1 To 1) 

For j = 1 To UBound(arrQ)
    answer = "WIN"
    
    Set found = ws.Columns("Q:Q").Find(what:=answer)
    
    If found Is Nothing Then
        arrBL(j, 1) = "0"  
    Else
        arrBL(j, 1) = "1" 
    End If
Next j

ws.Range("BL1").Resize(UBound(arrBL), 1).Value = arrBL

Many thanks!

CodePudding user response：

Find will search the entire column each time in the loop so if the value exist anywhere in the column the whole output array will return 1. If you want a row by row test then test each row:

Dim ws As Worksheet
Dim j As Long, LastRowOutcomeCleaned As Long
Dim arrQ as Variant, arrBL As Variant
Dim answer as string

'Note: this is dangerous as the order of sheets may change
'      Consider using the codename instead.  
Set ws = Workbooks("A.xlsx").Sheets(2) 
LastRow = ws.Range("Q" & Rows.Count).End(xlUp).Row

arrQ = ws.Range("Q2:Q" & LastRow).Value 
'Next line not needed as you redim it right after.
'arrBL = ws.Range("BL2:BL" & LastRow).Value 

ReDim arrBL(1 To UBound(arrQ), 1 To 1) 

For j = 1 To UBound(arrQ)
    answer = "WIN"
    
    If arrQ(j,1)=answer Then
        arrBL(j, 1) = 1  
    Else
        arrBL(j, 1) = 0 
    End If
Next j

ws.Range("BL1").Resize(UBound(arrBL), 1).Value = arrBL