I think I need to make an array but not sure.

[whitedel]

To all experts,
In an attempt to provide enough info -
I am trying to set up a VBA code which will search each cell in a specific column for a specific word, so far easy and I know how to do that, now for the hard (for me )part. I have 1700 rows. I also have over 150 words to search the column for. Now the key words are coupled with a type. For example I have 19 types of food, 15 types of fuel etc. I can search for the words individually but want to be able to use the type as a variable equal to all the words associated with the type. For example, the following are all types of food or as I classify them as "Food (Class I)” I would like to have "Food (Class I)” equal a range of the food types. Similar to "Food (Class I)” = beef, or bread or cake. And I would like to be able to add to the range

"Food (Class I)”

beef

bread

Cake

Cereal

cooking oil

dairy

Egg

food

Fruit

lamb

Legumes

Meat

milk

raisin

rice

sugar

tea

vegetable

wheat

<tbody>
</tbody>

I am trying to automate the classification column and update the types of food ( and other variables) to search for.

This is my rough attempt to describe the code I am trying to right

Dim sheet1 2 A1:A19 = "Food (Class I)”
Search sheet 2, column E for "Food (Class I)”
For each cell in sheet 2, column E that equals the variable "Food (Class I)”, offset - 1
And so on for the other classifications, fuel, construction, facilities etc.

Here is a sample of my data and a sample of my code so far. I am trying to automate the classification column

Data

Year	Directorate	No	Classification	Type of Contract
1389	Central	1	Facility Maintenance	Repair Kindergarten
1390	Central	1	Facility Lease	A Rental house for Addicates Hospital
1392	Central	1	Construction Works	37 lines of constructional materials
1393	Central	1	Individual Equipment (Class II)	Procuring 3 credit card
1391	Central	1	Food (Class I)	2 lines of meat
1392	Regional	1	Construction Works	procuring of 7 connex ( 3 connex 40 feetS and 4 connex 20 feets )
1390	Regional	1	Food (Class I)	Wheat Flour
1391	Regional	1	Generator	Const. of Power Station for 12th Police Dstrct
1393	Regional	1	Construction Material (Class IV)	Insulation
1393	Central	2	Facility Lease	Leasing house required by recuritment Department
1389	Central	2	Facility Maintenance	CID repairment
1392	Central	2	Repair Parts (Class IX)	66 lines of constructional equipment
1391	Central	2	Food (Class I)	7 lines of fresh fruit
1390	Central	2	Construction Works	Build 4 floors block for martyrs & Disables House
1391	Regional	2	Construction Works	Construction- Fuel Tank Installation for 6th Police District
1390	Regional	2	Individual Equipment (Class II)	2 line items of raisins & food spices
1392	Regional	2	Construction Works	procuring of 36 connex 20 feets
1393	Regional	2	Food (Class I)	28 Lines food materials
1393	Central	3	Facility Lease	Leasing house required by Meyers and disable Department
1389	Central	3	Facility Maintenance	Repair of Central org/mosque
1390	Central	3	Facility Maintenance	Repairing of streets,streams & green areas of Ministry
1392	Central	3	Construction Works	15 lines of constructional material
1393	Regional	3	POL (Class III)	2 Lines fuel
1391	Regional	3	Construction Works	Const. of toilet rooms and surrounding wall
1390	Regional	3	Individual Equipment (Class II)	4 line items of black & green tea, sugar and corn flour
1392	Regional	3	Construction Works	procuring of 116 connex (30 connex 20 feets and 86 connex 10 feets)

<tbody>
</tbody>

Current code

Sub Contracts_Classification()
Application.ScreenUpdating = False
Sheets("Combined Data").Activate
Dim contracts As Range
'Selects all populated rows in column b
For Each contracts In Range("e1:e" & Cells(Rows.Count, "e").End(xlUp).Row)
'Food (Class I)
If InStr(1, contracts, "beef", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "bread", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "Cake", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "Cereal", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "cooking oil", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "dairy", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "Egg", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "food", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "Fruit", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "lamb", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "Legumes", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "Meat", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "milk", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "raisin", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "rice", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "sugar", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "tea", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "vegetable", 1) Then contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, contracts, "wheat", 1) Then contracts.Offset(, -1) = "Food (Class I)"

V/r
Whitedel

 

[Andrew Poulsom]

If you list your food types on a worksheet and name the range, you can loop around the cells in that range in your VBA code. The name can be dynamic:

http://www.contextures.com/xlNames01.html#Dynamic

 

[AlphaFrog]

You could use the AutoFilter feature to filter an array of crteria if you are using Excel 2007 or later.

[color=darkblue]Sub[/color] Contracts_Classification()
    
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color], arr [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    Sheets("Combined Data").Activate
    
    LastRow = Range("E" & Rows.Count).End(xlUp).Row
    
    arr = Array("*beef*", "*bread*", "*Cake*", "*Cereal*", "*cooking oil*", "*dairy*", _
                "*Egg*", "*food*", "*Fruit*", "**", "*lamb*", "*Legumes*", "*meat*", _
                "*milk*", "*raisin*", "*rice*", "*sugar*", "*tea*", "*vegetable*", "*wheat*")
                
    Range("E1:E" & LastRow).AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues
    Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Value = "Food (Class I)"
    ActiveSheet.AutoFilterMode = [color=darkblue]False[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[whitedel]

Mr. Poulsom, I have been trying to use your and"AlphaFrog"'s advice for the last few days unsuccessfully. Here’s what I am trying to do. For each cell in sheet “Combined Data” column “C”, determine if it contains any value listed in the named range located in Sheet “ContractsClassification” column “A”. This range is named “Food” For each match found; update the adjacent cell in Column “B” to be “Food (Class I) “. Once I figure out the Food(Class I) group, I will work on other Contract Classes such as “IndividualEquipment (Class II)” and “POL (Class III)” etc.<o></o>
I have been able to accomplish my task by writing code to check for each individual value, but not for a range of values. My goal is to be use a "named range" as a variable and update the named range rather than writing a new line of code.

Thanks for your help!

V/r Whitedel

 

[Andrew Poulsom]

Try this (with a named range Food):

Sub Contracts_Classification()
    Dim contracts As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        For Each contracts In .Range("E1:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
            With contracts
                If .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Food," & .Address & "))))") Then
                    .Offset(, -1) = "Food (Class I)"
                End If
            End With
        Next contracts
    End With
End Sub

 

[whitedel]

Mr. Poulson,

Fantastic! That worked great.

Now if I add and "ElseIf" after the "IF" statement and before the "ENDIF could I add the other named ranges"?

Thank you very much for your help!

V/r
Whitedel

 

[Andrew Poulsom]

Now if I add and "ElseIf" after the "IF" statement and before the "ENDIF could I add the other named ranges"?

Yes.

 

[whitedel]

Mr. Poulsom,

I finally got the code to work. I learned a great deal about named ranges and VBA in general. Your help was invaluable. Once again, thank you for your kindness!

Below is a copy of my code.

Option Explicit
Sub Contracts_Classification()
Dim contracts As Range
Application.ScreenUpdating = False
sheets("Combined Data").Activate
With ActiveSheet
For Each contracts In .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
With contracts
If .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Food," & .Address & "))))") Then
.Offset(, -1) = "Food (Class I)"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(ICT," & .Address & "))))") Then
.Offset(, -1) = "ICT"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Black_Water," & .Address & "))))") Then
.Offset(, -1) = "Black Water"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Class_II," & .Address & "))))") Then
.Offset(, -1) = "Individual Equipment (Class II)"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(POL," & .Address & "))))") Then
.Offset(, -1) = "POL (Class III)"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Lease," & .Address & "))))") Then
.Offset(, -1) = "Facility Lease"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(CW," & .Address & "))))") Then
.Offset(, -1) = "Construction Works"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Repair," & .Address & "))))") Then
.Offset(, -1) = "Repair Parts Class (IX)"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Medical," & .Address & "))))") Then
.Offset(, -1) = "Medical Class VIII"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Generator," & .Address & "))))") Then
.Offset(, -1) = "Generator"

ElseIf .Parent.Evaluate("=SUMPRODUCT(--(ISNUMBER(SEARCH(Maintenance," & .Address & "))))") Then
.Offset(, -1) = "Facility Maintenance"

End If
End With
Next contracts
End With
End Sub


V/r
Whitedel