Check cells against an array

SamS

Well-known Member
Joined
Feb 17, 2002
Messages
542
I need to loop through column A matching the ActiveCell.Row to a declared Array and storing to a variable. Is there as simpler way to loop this code, a sample of what I have follows.

Range("A65533").End(xlUp).Select
LRow = ActiveCell.Row
Cells(1, 1).Select

Do Until ActiveCell.Row = LRow + 1
If ActiveCell = Empty Then
ActiveCell.Offset(1, 0).Select
Else
If ActiveCell = 49000 Then
Dep49 = ActiveCell.Row

ElseIf ActiveCell = 41000 Then
Dep41 = ActiveCell.Row

ElseIf ActiveCell = 42000 Then
Dep42 = ActiveCell.Row

ElseIf ActiveCell = 43000 Then
Dep43 = ActiveCell.Row
ElseIf (ActiveCell <> "49000") Or (ActiveCell <> "41000") Or (ActiveCell <> "42000") Then
Msg = "There was an error in the Department Code. Check all codes in Column 'A'. This routine has been cancelled!"
MsgBox Msg, , "Department Code Check"

Exit Sub
End If
ActiveCell.Offset(1, 0).Select
End If
Loop
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Dim cell As Range, Dep41#, Dep42#, Dep43#, Dep49#, msg$
For Each cell In Range([A1], [A65536].End(xlUp))
If cell = 49000 Then
Dep49 = cell.Row
ElseIf cell = 41000 Then
Dep41 = cell.Row
ElseIf cell = 42000 Then
Dep42 = cell.Row
ElseIf cell = 43000 Then
Dep43 = cell.Row
ElseIf cell <> "" Then
msg = "There was an error in the Department Code. Check all codes in Column 'A'. This routine has been cancelled!"
MsgBox msg, , "Department Code Check"
Exit Sub
End If
Next
 
Upvote 0
This one should be even more efficient :-

Dim rng As Range, cell as range, Dep41#, Dep42#, Dep43#, Dep49#, msg$
Set rng = Range([A1], [A65536].End(xlUp))
With Application.WorksheetFunction
If .CountIf(rng, 49000) + .CountIf(rng, 41000) + .CountIf(rng, 42000) + .CountIf(rng, 43000) + .CountIf(rng, "") <> rng.Cells.Count Then
msg = "There was an error in the Department Code. Check all codes in Column 'A'. This routine has been cancelled!"
MsgBox msg, , "Department Code Check"
Exit Sub
Else: For Each cell In rng
If cell = 49000 Then
Dep49 = cell.Row
ElseIf cell = 41000 Then
Dep41 = cell.Row
ElseIf cell = 42000 Then
Dep42 = cell.Row
ElseIf cell = 43000 Then
Dep43 = cell.Row
End If
Next
End With


And this one should be even still more efficient :-

Dim rng As Range, find As Range, Dep41#, Dep42#, Dep43#, Dep49#, msg$
Set rng = Range([A1], [A65536].End(xlUp))
With Application.WorksheetFunction
If .CountIf(rng, 49000) + .CountIf(rng, 41000) + .CountIf(rng, 42000) + .CountIf(rng, 43000) + .CountIf(rng, "") <> rng.Cells.Count Then
msg = "There was an error in the Department Code. Check all codes in Column 'A'. This routine has been cancelled!"
MsgBox msg, , "Department Code Check"
Exit Sub
Else
Set find = Columns(1).find(What:="49000", After:=[A65536], _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not find Is Nothing Then Dep49 = find.Row
Set find = Columns(1).find(What:="41000", After:=[A65536], _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not find Is Nothing Then Dep41 = find.Row
Set find = Columns(1).find(What:="42000", After:=[A65536], _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not find Is Nothing Then Dep42 = find.Row
Set find = Columns(1).find(What:="43000", After:=[A65536], _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not find Is Nothing Then Dep43 = find.Row
End If
End With
 
Upvote 0
Tikas - thanks for your reply. You have given me some food for thought here. One of the problems I have is that there are some 30+ departments that management keep restructuring (major reshuffle about to happen again) and I was looking for a method whereby declaring an array upfront would take most of the work out of modifying the code each time. This code is used in about 11 different spreadsheets at different times to gather information and eventually post it to another Summary spreasheet. The number of departments and their codes can vary from 6 to all 30+ , whereby my enquiry.
 
Upvote 0
Sam
what might be an idea is to have a sheet with all relevant department names and the approprate value next o it and search against that
On 2002-02-19 13:37, SamS wrote:
Tikas - thanks for your reply. You have given me some food for thought here. One of the problems I have is that there are some 30+ departments that management keep restructuring (major reshuffle about to happen again) and I was looking for a method whereby declaring an array upfront would take most of the work out of modifying the code each time. This code is used in about 11 different spreadsheets at different times to gather information and eventually post it to another Summary spreasheet. The number of departments and their codes can vary from 6 to all 30+ , whereby my enquiry.
 
Upvote 0
I can help you with the array part if you can give me a bit more information. Are you trying to find the first row in which you find the department values (41000, 49000, etc.), or the last row (or maybe something else)? If you could expand a bit I think I can help you write some code that would work no matter how many departments you have...

-Russell
 
Upvote 0
Russell
There are a number of spreadsheets all different formats created by different people (necessary as they relate to different topics eg Safety Stats, HR Contractor usage etc).
As they all had one basic similarity which was the Department name in the first column I inserted another (hidden)column before the department name and added the department codes.
I need to identify the ActiveCell.Row for each Department eg 41000, 41010, 42000, 42010, 42020, 43000, 43010 etc and the rows for each department varies between spreadsheets. The numbering of departments are not very consistent (to many restructures) with the exception that they all start with "4" and are of 5 digits in length.

There are blank cells between some of the department codes which is why I search for the last cell in column A.

This part of the macro would be embedded into each of the spreadsheets and would need to be easily modified ie change it in one spreadsheet and copy and paste to all others.

The row in the spreadsheet I copy the data to is a fixed structure which makes it easy for the latter part of the macro.

The various spreadsheets are modified by different users at different times and the requirement is that the summary data is written to the final workbook as each work book is completed.

Hopefully this gives you an insight into what I am trying to do.

On 2002-02-19 14:01, Russell Hauf wrote:
I can help you with the array part if you can give me a bit more information. Are you trying to find the first row in which you find the department values (41000, 49000, etc.), or the last row (or maybe something else)? If you could expand a bit I think I can help you write some code that would work no matter how many departments you have...

-Russell
 
Upvote 0
Hmm. Still not totally clear...

What I would suggest is to make a workbook with one sheet that has a table of all of the departments and their codes. Then you could assign the array. I hope that the code below can give you an idea - it's pretty complicated, but I tried to give explanations in the comments. Again, it's hard to tell exactly what you are doing. Hope this helps,

Russell

<pre><font color='#000000'>
<font color='#000080'>Option</font> <font color='#000080'>Explicit</font>

<font color='#000080'>Sub</font> DepartmentRows()

<font color='#000080'>Dim</font> intRow <font color='#000080'>As</font> <font color='#000080'>Integer</font>
<font color='#000080'>Dim</font> intLastRow <font color='#000080'>As</font> <font color='#000080'>Integer</font>
<font color='#000080'>Dim</font> var1 <font color='#000080'>As</font> <font color='#000080'>Variant</font>
<font color='#000080'>Dim</font> intIdx <font color='#000080'>As</font> <font color='#000080'>Integer</font>
<font color='#000080'>Dim</font> intI <font color='#000080'>As</font> <font color='#000080'>Integer</font>

Workbooks("Departments.xls").Sheets("Depts").Select

<font color='#008000'>' Initialize the workbook with the data in the Departments</font>
<font color='#008000'>' workbook. This requires the UsedRange to be only the data</font>
<font color='#008000'>' you have entered. You can delete all rows below and all</font>
<font color='#008000'>' columns to the right of the range if need be to get the</font>
<font color='#008000'>' UsedRange to be only the cells with data (to check, type</font>
<font color='#008000'>' Ctrl + End and see if that is the last cell with data).</font>
var1 = ActiveSheet.UsedRange
ReDim Preserve var1(1 To UBound(var1, 1), 1 To UBound(var1, 2) + 1)

Workbooks("Data1.xls").Worksheets("Data").Select

intLastRow = Range("A65533").End(xlUp).Row

<font color='#008000'>' The CheckDepartment function checks to see if the</font>
<font color='#008000'>' value you passed it (the code, or current cell) is</font>
<font color='#008000'>' in your list of codes. I did not do any error check-</font>
<font color='#008000'>' ing here - if the code does not match, then nothing</font>
<font color='#008000'>' happens, it just keeps checking the cells. It also</font>
<font color='#008000'>' returns the position in the array where the match</font>
<font color='#008000'>' was found, so you can add the row to the array.</font>
<font color='#000080'>For</font> intRow = 1 To intLastRow
<font color='#000080'>If</font> CheckDepartment(var1, Cells(intRow, 1), intIdx) <font color='#000080'>Then</font>
var1(intIdx, 3) = intRow
<font color='#000080'>End</font> <font color='#000080'>If</font>
<font color='#000080'>Next</font> intRow

<font color='#000080'>For</font> intI = 1 To UBound(var1, 1)
<font color='#000080'>If</font> <font color='#000080'>Not</font> IsEmpty(var1(intI, 3)) <font color='#000080'>Then</font>
<font color='#008000'>' Print the department and row - you can put these</font>
<font color='#008000'>' values into cells on another sheet/workbook if</font>
<font color='#008000'>' you like.</font>
Debug.Print var1(intI, 2) & " " & var1(intI, 3)
<font color='#000080'>End</font> <font color='#000080'>If</font>
<font color='#000080'>Next</font> intI
<font color='#000080'>End</font> <font color='#000080'>Sub</font>


<font color='#000080'>Function</font> CheckDepartment(ByVal varArray <font color='#000080'>As</font> Variant, _
ByVal lngDepartment <font color='#000080'>As</font> Long, _
ByRef intIdx <font color='#000080'>As</font> Integer) <font color='#000080'>As</font> Boolean
<font color='#008000'>' In: varArray -an array of values</font>
<font color='#008000'>' lngDepartment -value you want to check to see if it's</font>
<font color='#008000'>' in varArray (in the first dimension,</font>
<font color='#008000'>' which was hard-coded for this example.</font>
<font color='#008000'>' Out: intIdx -holds the position in the array where</font>
<font color='#008000'>' lngDepartment was found (if value of</font>
<font color='#008000'>' CheckDepartment is true).</font>

<font color='#000080'>Dim</font> intI <font color='#000080'>As</font> <font color='#000080'>Integer</font>

<font color='#000080'>For</font> intI = 1 To UBound(varArray, 1)
<font color='#000080'>If</font> varArray(intI, 1) = lngDepartment <font color='#000080'>Then</font>
CheckDepartment = True
intIdx = intI
<font color='#000080'>End</font> <font color='#000080'>If</font>
<font color='#000080'>Next</font> intI

<font color='#000080'>End</font> <font color='#000080'>Function</font>

</font></pre>
 
Upvote 0
Russell
I worked my way through the code to try and fully understand the workings and it will do what I want and i has also made me rethink the rest of my coding. Many thanks.

BTW - the color scheme is difficult to read eg comments are a light green on a dark blue background and had to be printed before I could read them. When I first visited the new message board the color scheme was lighter and easier to read.
 
Upvote 0
Russell,

Did you really put in all of the font color metatags or have you got some nifty sofware that will generate that for you?

It was a nice looking post.
 
Upvote 0

Forum statistics

Threads
1,213,559
Messages
6,114,302
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top