VBA Beginner needs help

[whitedel]

I am trying to categorize some Contracts data. I am in Afghanistan and working on Afghan contracts trackers. The data has been translated from Dari to English by non-native English speakers so there is a great deal of variability. All that being said I have built the following VBA macro, but am now getting an out of memory error. Please advise the best way to make my macro more efficient.

Option Explicit
Sub Contracts_Classification()

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, "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, "Meat", 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, "Egg", 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, "vegetable", 1) Then Contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, Contracts, "wheat", 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, "dairy", 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, "rice", 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, "tea", 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, "lamb", 1) Then Contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, Contracts, "beef", 1) Then Contracts.Offset(, -1) = "Food (Class I)"
If InStr(1, Contracts, "cooking oil", 1) Then Contracts.Offset(, -1) = "Food (Class I)"
'POL (Class III)
If InStr(1, Contracts, "fuel", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "petro", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "diesel", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "mogas", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "propane", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "grease", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "gasoline", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "fire wood", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "gas", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "lubricant", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
If InStr(1, Contracts, "kerosene", 1) Then Contracts.Offset(, -1) = "POL (Class III)"
'Black Water
If InStr(1, Contracts, "Black Water", 1) Then Contracts.Offset(, -1) = "Black Water"
If InStr(1, Contracts, "Septic", 1) Then Contracts.Offset(, -1) = "Black Water"

'Construction Works
If InStr(1, Contracts, "reconstruction", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "constructing", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "Construction", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "install", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "digging", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "well", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "check point", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "install", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "digging", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "drilling", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "checkpoint", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "concreting", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "paving", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "construct", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "const", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "drilling", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "checkpoint", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "concrete", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "wall", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "checkpoint", 1) Then Contracts.Offset(, -1) = "Construction Works"
If InStr(1, Contracts, "concrete", 1) Then Contracts.Offset(, -1) = "Construction Works"
'Construction Material (Class IV)
If InStr(1, Contracts, "Construction Material", 1) Then Contracts.Offset(, -1) = "Construction Material (Class IV)"
If InStr(1, Contracts, "Construction Material", 1) Then Contracts.Offset(, -1) = "Construction Material (Class IV)"
'Facility Maintenance
If InStr(1, Contracts, "repair", 1) Then Contracts.Offset(, -1) = "Facility Maintenance"
If InStr(1, Contracts, "painting", 1) Then Contracts.Offset(, -1) = "Facility Maintenance"
If InStr(1, Contracts, "Facility Maintenance", 1) Then Contracts.Offset(, -1) = "Facility Maintenance"
If InStr(1, Contracts, "maintenance", 1) Then Contracts.Offset(, -1) = "Facility Maintenance"
If InStr(1, Contracts, "repair", 1) Then Contracts.Offset(, -1) = "Facility Maintenance"
If InStr(1, Contracts, "painting", 1) Then Contracts.Offset(, -1) = "Facility Maintenance"


Next Contracts
End Sub

 

[saltkev]

Re: VBA Beginner needs help - data sample

Apologies, stupidity blindness, didn’t see the in-string </SPAN></SPAN>

 

[saltkev]

Re: VBA Beginner needs help - data sample

Hi

glasses on now, try this, not sure it is any more efficiant than yours but it does run without errors.

Application.ScreenUpdating = False
Sheets("combined data").Activate
'##### Define Variables #######
Static contracts, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15, F16, F17, F18 'Food Variables
Static C1, C2, C3, C4, C5, C6, C7, C8, C9, C10, C11 'Fuel Variables
Static B1, B2 'Black Water Variables
Static Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8, Z9, Z10, Z11, Z12 'Construction Work Variables
Static ZM1, ZM2 'Construction Material Variables
Static FM1, FM2, FM3, FM4 'Facilities Maint Variables
'##### Populate Variables #######
F1 = "*Fruit*"
F2 = "*Meat*"
F3 = "*Egg*"
F4 = "*food*"
F5 = "*Cake*"
F6 = "*Cereal*"
F7 = "*Vegetable*"
F8 = "*wheat*"
F9 = "*bread*"
F10 = "*dairy*"
F11 = "*milk*"
F12 = "*rice*"
F13 = "*sugar*"
F14 = "*lamb*"
F15 = "*beef*"
F16 = "*cooking oil*"
F17 = "*raisin*"
F18 = "*tea*"
C1 = "*fuel*"
C2 = "*petro*"
C3 = "*diesel*"
C4 = "*mogas*"
C5 = "*propane*"
C6 = "*grease*"
C7 = "*gasoline*"
C8 = "*fire wood*"
C9 = "*gas*"
C10 = "*lubricant*"
C11 = "*kerosene*"
B1 = "*Black*"
B2 = "*Septic*"
Z1 = "*reconstruction*"
Z2 = "*Construction*"
Z3 = "*constructing*"
Z4 = "*install*"
Z5 = "*dig*"
Z6 = "*well*"
Z7 = "*check*"
Z8 = "*drill*"
Z9 = "*concreting*"
Z10 = "*paving*"
Z11 = "*construct*"
Z12 = "*const*"
Z13 = "*concrete*"
ZM1 = "*Construction Material*"
ZM2 = "*construction material*"
FM1 = "*repair*"
FM2 = "*paint**"
FM3 = "*Facility Maintenance*"
FM4 = "*maintenance*"
'##### Define Working Range #####

lr = Sheets("combined data").Range("e1000000").End(xlUp).Row
      
lrange = Sheets("combined data").Range("e2:e" & lr).Address(False, False)
'~~~~~~~ Loop Through Each String in Column "E" ~~~~~~~~~~~

For Each contract In ActiveSheet.Range(lrange)

'##### If Statment For Food #####
If contract.Value Like F1 Or contract.Value Like F2 Or contract.Value Like F3 _
     Or contract.Value Like F4 Or contract.Value Like F5 Or contract.Value Like F6 _
     Or contract.Value Like F7 Or contract.Value Like F8 Or contract.Value Like F9 _
     Or contract.Value Like F10 Or contract.Value Like F11 Or contract.Value Like F12 _
     Or contract.Value Like F13 Or contract.Value Like F14 Or contract.Value Like F15 _
     Or contract.Value Like F16 Or contract.Value Like F17 Or contract.Value Like F18 Then
   
contract.Offset(0, -1).Value = "Food (Class I)"
End If
'##### If Statment For Fuel #####
If contract.Value Like C1 Or contract.Value Like C2 Or contract.Value Like C3 _
     Or contract.Value Like C4 Or contract.Value Like C5 Or contract.Value Like C6 _
     Or contract.Value Like C7 Or contract.Value Like C8 Or contract.Value Like C9 _
     Or contract.Value Like C10 Or contract.Value Like C11 Then
   
contract.Offset(0, -1).Value = "POL (Class III)"
End If
'##### If Statment For Foul Water #####
If contract.Value Like B1 Or contract.Value Like B2 Then
   
contract.Offset(0, -1).Value = "Black Water"
End If
'##### If Statment For Construction Work #####
If contract.Value Like Z1 Or contract.Value Like Z2 Or contract.Value Like Z3 _
     Or contract.Value Like Z4 Or contract.Value Like Z5 Or contract.Value Like Z6 _
     Or contract.Value Like Z7 Or contract.Value Like Z8 Or contract.Value Like Z9 _
     Or contract.Value Like Z10 Or contract.Value Like Z11 Or contract.Value Like Z12 _
     Or contract.Value Like Z13 Then
   
contract.Offset(0, -1).Value = "Construction Works)"
End If
'##### If Statment For Construction Material #####
If contract.Value Like ZM1 Or contract.Value Like ZM2 Then
   
contract.Offset(0, -1).Value = "Construction Material (Class IV)"
End If
'##### If Statment For Facilities Maint #####
If contract.Value Like FM1 Or contract.Value Like FM2 Or contract.Value Like FM3 _
    Or contract.Value Like FM4 Then
   
contract.Offset(0, -1).Value = "Facility Maintenance"
End If
Next contract

 

[saltkev]

Re: VBA Beginner needs help - data sample

Just thinking about it, use of an array would be a little more efficiant.

Kev

 

[whitedel]

Re: VBA Beginner needs help - data sample

Kev,
You are very kind and generous with your knowledge. I am amazed at both how quickly you and others responded to my request for help and the level of detail provided. Thank you very much for your help. I am going to try your suggestions. More importantly, I am going to dissect it so I understand VBA code better.

V/r
Whitedel

 

[whitedel]

Re: VBA Beginner needs help - data sample

Experts, I received some great info on my first request for assistance so I am going back to the well of knowledge for some more help.

I would like to take a list of values and turn it into a single variable. For example I would like to take a column that has many different types of food and have each equal to “Food Class (I)”
I.E. “Food Class (I)” is equal to any item in the column below and when I add more food items, they also become part of the “Variable”
[TABLE="width: 81"]
<tbody>[TR]
[TD]food
[/TD]
[/TR]
[TR]
[TD]Fruit
[/TD]
[/TR]
[TR]
[TD]Meat
[/TD]
[/TR]
[TR]
[TD]Cake
[/TD]
[/TR]
[TR]
[TD]Egg
[/TD]
[/TR]
[TR]
[TD]Cereal
[/TD]
[/TR]
[TR]
[TD]vegetable
[/TD]
[/TR]
[TR]
[TD]wheat
[/TD]
[/TR]
[TR]
[TD]bread
[/TD]
[/TR]
[TR]
[TD]dairy
[/TD]
[/TR]
[TR]
[TD]milk
[/TD]
[/TR]
[TR]
[TD]rice
[/TD]
[/TR]
[TR]
[TD]raisin
[/TD]
[/TR]
[TR]
[TD]tea
[/TD]
[/TR]
[TR]
[TD]sugar
[/TD]
[/TR]
[TR]
[TD]lamb
[/TD]
[/TR]
[TR]
[TD]beef
[/TD]
[/TR]
[TR]
[TD]cooking oil
[/TD]
[/TR]
[TR]
[TD]Legumes
[/TD]
[/TR]
[TR]
[TD]powder milk
[/TD]
[/TR]
</tbody>[/TABLE]

 

[saltkev]

Re: VBA Beginner needs help - data sample

Hi

This sounds like a job for a two dimensional Array, Make a new sheet in your workbook. In col "A" list all Your items, In Col "B" assigne the Catergory Class I Class or Class III or what ever. Then use this forum to look for advice with Arrays. The range of data you have just entered can be used to populate the array. Have a look at advice in this forum or others and it will become clear. If not come back and I will try to help. But I will need more info.


Kev