Check cells against an array

[SamS]

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

[Tikas A. Planck]

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

[Tikas A. Planck]

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

[SamS]

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.

[JohnG]

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.

[Russell Hauf]

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

[SamS]

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

[Russell Hauf]

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

Option Explicit 



Sub DepartmentRows() 



    Dim intRow As Integer 

    Dim intLastRow As Integer 

    Dim var1 As Variant 

    Dim intIdx As Integer 

    Dim intI As Integer 

    

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

   

    ' Initialize the workbook with the data in the Departments

    ' workbook.  This requires the UsedRange to be only the data

    ' you have entered.  You can delete all rows below and all

    ' columns to the right of the range if need be to get the

    ' UsedRange to be only the cells with data (to check, type

    ' Ctrl + End and see if that is the last cell with data).

    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 

    

    ' The CheckDepartment function checks to see if the

    ' value you passed it (the code, or current cell) is

    ' in your list of codes.  I did not do any error check-

    ' ing here - if the code does not match, then nothing

    ' happens, it just keeps checking the cells.  It also

    ' returns the position in the array where the match

    ' was found, so you can add the row to the array.

    For intRow = 1 To intLastRow 

        If CheckDepartment(var1, Cells(intRow, 1), intIdx) Then 

            var1(intIdx, 3) = intRow 

        End If 

    Next intRow 

        

    For intI = 1 To UBound(var1, 1) 

        If Not IsEmpty(var1(intI, 3)) Then 

            ' Print the department and row - you can put these

            ' values into cells on another sheet/workbook if

            ' you like.

            Debug.Print var1(intI, 2) & " " & var1(intI, 3) 

        End If 

    Next intI 

End Sub 





Function CheckDepartment(ByVal varArray As Variant, _ 

                         ByVal lngDepartment As Long, _ 

                         ByRef intIdx As Integer) As Boolean 

' In:   varArray       -an array of values

'       lngDepartment  -value you want to check to see if it's

'                       in varArray (in the first dimension,

'                       which was hard-coded for this example.

' Out:  intIdx         -holds the position in the array where

'                       lngDepartment was found (if value of

'                       CheckDepartment is true).



    Dim intI As Integer 

    

    For intI = 1 To UBound(varArray, 1) 

        If varArray(intI, 1) = lngDepartment Then 

            CheckDepartment = True 

            intIdx = intI 

        End If 

    Next intI 

    

End Function 

[SamS]

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.

[Mark O'Brien]

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.