Find blank cells and array items addresses to arraylist

[Vincent88]

Hi Guys, I want to find the cell addresses to a Arraylist (blankarray) of those values in an array (bArray). It seems that the code adds those blank cells' addresses only but not those values to Arraylist. Please advise correction to my code to make it works.
Also I want to list those findings of each row in individual column in the Arraylist (meaning findings of row 3 in rngData shown in column 1 of Arraylist , that of row 4 shown in column 2 of Arraylist and so on).
Thanks.

Sub rngOver32()

Dim cl As Range, rngData As Range

Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False


Dim lastrow As Long, lastcol As Long
lastrow = Range("A3").End(xlDown).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

'LIST OF VALUE TO FIND
Dim bArray As Variant
bArray = Array("AL", "SL", "BL", "CL", "PL", "VL", vbNullString)
Dim bArraystr As String


'EXPORT CELL ADDRESSES TO ARRAYLIST
Dim blankarray As Object
Set blankarray = CreateObject("System.Collections.ArrayList")

'SET DATA RANGE TO SEARCH
Set rngData = Range(Cells(3, 3), Cells(lastrow, lastcol))
Debug.Print rngData.Address

On Error GoTo ErrorHandler

For Each cl In rngData
    If cl.Value = bArraystr Then
       If Not blankarray.contains(cl.Address) Then blankarray.Add cl.Address
    End If
Next cl

ErrorHandler:
Application.EnableEvents = True
   
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

AgentProposal_Roster0728_1025M.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL
1	MDate	Attendance	26-Nov	27-Nov	28-Nov	29-Nov	30-Nov	1-Dec	2-Dec	3-Dec	4-Dec	5-Dec	6-Dec	7-Dec	8-Dec	9-Dec	10-Dec	11-Dec	12-Dec	13-Dec	14-Dec	15-Dec	16-Dec	17-Dec	18-Dec	19-Dec	20-Dec	21-Dec	22-Dec	23-Dec	24-Dec	25-Dec	26-Dec	27-Dec	28-Dec	29-Dec	30-Dec	31-Dec
2	Date	Summary	(5)	(4)	(3)	(2)	(1)	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
3	Xia M	T:22 L:2.5 D:16.5 E:7 N:0	G	G	G	G	G	G	VL	VL	G			G	D	K	E	E	E		D	D	D	D	D		AM	D	D	D	D	D	D		E	E	E	E
4	Zita V	T:22 L:1 D:12 E:11 N:0	D			D	D	D		D	D	D		E	E	E	E	E		D	D	D	D	D			D	D	D		CL	E	E	E	E	E	E
5	Ken C	T:22 L:6 D:5 E:5 N:11	K			K	K	K	K	K	K	K		AL	N	N	N	N	N			E	E	E	E	E		AL	N	N	N	N	N	N	AL	AL	AL	AL
6	Larry Q	T:22 L:0 D:15 E:0 N:0	D3			D3	D3	D3	D3	D3	D3		D4	D4	D4	D4	D4				D4	D4	D4	D4	D4	G
7	John G	T:22 L:0.5 D:17.5 E:5 N:0		E	E			E	E	E	E	E				D1	D1	D1			G	G	G	G	G		PM	G	G	G	G	G			G	G	G	G
202112

Cells with Data Validation
Cell	Allow	Criteria
A3:A7	List	=HelpAgent
H3:AL7	List	=ShiftcodeNew
A1	List	=Data!$U$2:$U$15

 

[offthelip]

You are not checking all the values in Barray, Try this small modification, not necesarily the fastest way of doing this.

Sub rngOver32()

Dim cl As Range, rngData As Range

Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False


Dim lastrow As Long, lastcol As Long
lastrow = Range("A3").End(xlDown).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

'LIST OF VALUE TO FIND
Dim bArray As Variant
bArray = Array("AL", "SL", "BL", "CL", "PL", "VL", vbNullString)
Dim bArraystr As String


'EXPORT CELL ADDRESSES TO ARRAYLIST
Dim blankarray As Object
Set blankarray = CreateObject("System.Collections.ArrayList")

'SET DATA RANGE TO SEARCH
Set rngData = Range(Cells(3, 3), Cells(lastrow, lastcol))
Debug.Print rngData.Address

On Error GoTo ErrorHandler
For i = 1 To UBound(bArray)
bArraystr = bArray(i)
For Each cl In rngData
    If cl.Value = bArraystr Then
       If Not blankarray.contains(cl.Address) Then blankarray.Add cl.Address
    End If
Next cl
Next i
ErrorHandler:
Application.EnableEvents = True
   
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Vincent88]

Hi offthelip,
It seems working. Can I add below code to output the findings to columns in another worksheet to review ?
(There are 5 rows of data to be listed in 5 columns in blankarray)

Dim blankarray_result As Variant
blankarray_result = blankarry.toarray

'Export Findings to Sheets("Data") Z Column
Sheets("Data").Range("Z1:Z" & Sheets("Data").Range("Z1").End(xlDown).Row).ClearContents
Sheets("Data").Range("Z1").Resize(UBound(blankarray_result) + 1, 1).Value = Application.Transpose(blankarray_result)

 

[offthelip]

Can I add below code to output the findings to columns in another worksheet to review ?
(There are 5 rows of data to be listed in 5 columns in blankarray)

I don't ever use collections since I always use dictionaries instead. So I can't help you with any syntax you need to write out your collection.

 

[Vincent88]

Hi offthetop , what the code should be if using dictionaries to meet my goal.

 

[offthelip]

I wouldn't actually use a dictionary to do what I think you are trying to do, I would just use variant arrays, like this:

Sub rngOver32()

'Dim cl As Range,
Dim rngData As Variant

'Application.DisplayStatusBar = False
'Application.EnableEvents = False
'Application.ScreenUpdating = False
' Not necesary since we are not triggering events or updating the worksheet

Dim lastrow As Long, lastcol As Long
lastrow = Range("A1").End(xlDown).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

'LIST OF VALUE TO FIND
Dim bArray As Variant
bArray = Array("AL", "SL", "BL", "CL", "PL", "VL", vbNullString)
Dim bArraystr As String




Dim blankarray() As Variant

ReDim blankarray(1 To lastrow * lastcol, 1 To 1)
'Load DATA RANGE TO SEARCH
rngData = Range(Cells(1, 1), Cells(lastrow, lastcol)) ' this load the data into a variant array (much faster)


'On Error GoTo ErrorHandler don't do this it just hides any error
indi = 1
For i = 1 To UBound(bArray)
bArraystr = bArray(i)
 For j = 3 To lastrow ' Note we are starting on row 3 as per the original
   For k = 3 To lastcol
    If rngData(j, k) = bArraystr Then
       blankarray(indi, 1) = colno2let(k) & j
       indi = indi + 1
    End If
   Next k
 Next j
Next i
With Worksheets("sheet2")
 .Range(.Cells(1, 1), .Cells(indi - 1, 1)) = blankarray
'ErrorHandler:
End With
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


Function colno2let(colno As Variant) As String
let2 = colno / 26
If let2 > 1 Then
 let22 = Round(let2)
 txt = Chr(let22 + 64)
 txt = txt & Chr(64 + colno - (26 * let22))
Else
txt = Chr(colno + 64)
End If
colno2let = txt

End Function

Note the colno2let function only works up to column ZZ
Note however I don't know why you want a list of addresses on a worksheet, this can't be the ultimate goal

 

[Vincent88]

Hi offthelip, I got this error when running the code. I just want to review the blankarray result in column AA in worksheet named "Data".
Your advice in Post #2 seems working but I just want to see the output result (this is just for my learning only and not necessary in actual execution of the marco).
Yes, your curiosity is right. My ultimate goal is to find if those cells which fall in bArray conditions' column displacement is more than five, then highlight those cells in between them.
I attach the expected blankarray list's image and from that count the displacement between T3 and M3 (col 20 - col 13 -1=6) then applying the result to active worksheet to highlight cells between S3 to N3, so does the cells between AH3 and Z3 where cells AG3:AA3 in active worksheet will be highlighted and so does the other rows and columns .......
Appreciate your advice. Thanks.

 

[offthelip]

I have no idea why you are getting an error. when I run the code on the data you posted in post#1 it runs perfectly, and produces a list of address in column A of sheet2 : this is the start of the list:

AE4

I3

J3

L3

M3

T3

Z3

AH3

D4

E4

I4

 

[Vincent88]

Hi, what should be changed if I want the result to be viewed in sheet "Data" column AA

 

[offthelip]

change:

With Worksheets("sheet2")

to

With Worksheets("Data")

i.e. your change looks correct.
When or if you get an error check what the value in "indi" is