VBA Beginner needs help

whitedel

New Member
Joined
May 27, 2014
Messages
13
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
 
Re: VBA Beginner needs help - data sample

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

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
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.

Code:
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
 
Upvote 0
Re: VBA Beginner needs help - data sample

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

Kev
 
Upvote 0
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
 
Upvote 0
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”
food
Fruit
Meat
Cake
Egg
Cereal
vegetable
wheat
bread
dairy
milk
rice
raisin
tea
sugar
lamb
beef
cooking oil
Legumes
powder milk

<tbody>
</tbody>
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,215,565
Messages
6,125,583
Members
449,237
Latest member
Chase S

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