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

whitedel

New Member
Joined
May 27, 2014
Messages
13
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)”
[TABLE="width: 60"]
<tbody>[TR]
[TD]beef
[/TD]
[/TR]
[TR]
[TD]bread
[/TD]
[/TR]
[TR]
[TD]Cake
[/TD]
[/TR]
[TR]
[TD]Cereal
[/TD]
[/TR]
[TR]
[TD]cooking oil
[/TD]
[/TR]
[TR]
[TD]dairy
[/TD]
[/TR]
[TR]
[TD]Egg
[/TD]
[/TR]
[TR]
[TD]food
[/TD]
[/TR]
[TR]
[TD]Fruit
[/TD]
[/TR]
[TR]
[TD]lamb
[/TD]
[/TR]
[TR]
[TD]Legumes
[/TD]
[/TR]
[TR]
[TD]Meat
[/TD]
[/TR]
[TR]
[TD]milk
[/TD]
[/TR]
[TR]
[TD]raisin
[/TD]
[/TR]
[TR]
[TD]rice
[/TD]
[/TR]
[TR]
[TD]sugar
[/TD]
[/TR]
[TR]
[TD]tea
[/TD]
[/TR]
[TR]
[TD]vegetable
[/TD]
[/TR]
[TR]
[TD]wheat
[/TD]
[/TR]
</tbody>[/TABLE]

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

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
You could use the AutoFilter feature to filter an array of crteria if you are using Excel 2007 or later.
Code:
[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]
 
Upvote 0
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:p></o:p>
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
 
Upvote 0
Try this (with a named range Food):

Code:
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,874
Members
452,363
Latest member
merico17

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