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
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Hi

Have a look at select case, this is straight from help screen.


<CODE>D
Code:
im NumberNumber = 8    ' Initialize variable.[B]Select Case</STRONG> Number    ' Evaluate Number.[B]Case</STRONG> 1 To 5    ' Number between 1 and 5, inclusive.    Debug.Print "Between 1 and 5"' The following is the only Case clause that evaluates to True.[B]Case</STRONG> 6, 7, 8    ' Number between 6 and 8.    Debug.Print "Between 6 and 8"[B]Case</STRONG> 9 To 10    ' Number is 9 or 10.Debug.Print "Greater than 8"[B]Case Else</STRONG>    ' Other values.    Debug.Print "Not between 1 and 10"[B]End Select</STRONG>
</CODE></PRE>[/B][/B][/B][/B][/B][/B]
 
Upvote 0
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.
...

I very minimally tested, but did not encounter an error. Please advise how many rows of data there are. Also, whilst probably a bit painful, have you stepped through the code and figured out where it errors exactly?

Mark
 
Upvote 0
GTO,
There are 7500 rows. I started slow and worked with the Food Class I group expanding the variables as I went. I progress through the different lines until I added the last line. I figure I am brute forcing this and there is a much more efficient way to accomplish my goal. Maybe set each group as a variable and assign it to a set of set of variables IE food class I = food or dairy or cereal. But I don’t know how to accomplish this.

Thanks for your help!
 
Last edited:
Upvote 0
Salkev,
I know you have told me something important, but I am not experianced enough to understand it. If you have the patience, please splain it to me.

V/r
Whitedel
 
Upvote 0
GTO,
There are 7500 rows. I started slow and worked with the Food Class I group expanding the variables as I went. I progress through the different lines until I added the last line. I figure I am brute forcing this and there is a much more efficient way to accomplish my goal. Maybe set each group as a variable and assign it to a set of set of variables IE food class I = food or dairy or cereal. But I don’t know how to accomplish this.

Thanks for your help!

Off to bed for this lad, but might I suggest that we take logical steps. Yes, I would think there easier ways to do this, but I think it would be good to see why the error is occurring. Not to repeat myself, but have you stepped through it, or maybe tack in a Debug.Print statement to see about where the error is occurring?

As to an improved solution, it might be best to show us some sample data. Where are we looking for the values, anyplace in the cells' individual strings? With as many "matches" as you show, I would consider entering these values in different columns on a sheet. Then we would work from there to build some OR tests most likely.

Mark
 
Upvote 0
OK no probs

I will cobble an example together using your data, generally if you have a large number of if statments it is easier to use a select case.
 
Upvote 0
Hi

Try this under a Command button. It will need some additions to the case variations, but it works.

Code:
Application.ScreenUpdating = False
Sheets("combined data").Activate
Static contracts

'##### Define Working Range #####

lr = Sheets("combined data").Range("e1000000").End(xlUp).Row
      
lrange = Sheets("combined data").Range("e2:e" & lr).Address(False, False)

For Each contract In ActiveSheet.Range(lrange)
 
Select Case contract
'##### Add as Many Cases as You Wish, & as Many Variations Per Case as You Need
Case "Fruit", "Meat", "Egg", "Cerial", "Vegatable" 'Add Any Combination Uppercase/Lovercase
contract.Offset(0, -1).Value = "Food (Class I)" ' What Happens When Case is Met

Case "Fuel", "Petrol", "Propane", "Diesel"

contract.Offset(0, -1).Value = "POL(Class III)"
End Select

Next contract

regards

Kev
 
Upvote 0
GTO,
The code started working again after I closed some other programs and excel sheets. Not sure why it worked because I rebooted yesterday and started from a clean slate and still had the same problem. So still would like any help you or the other kind souls are willing to provide i regards to making the code more efficient.

V/r
Whitedel
 
Last edited:
Upvote 0
Re: VBA Beginner needs help - data sample

[TABLE="width: 1235"]
<tbody>[TR]
[TD]Year
[/TD]
[TD]Directorate
[/TD]
[TD]No
[/TD]
[TD]Classification
[/TD]
[TD]Type of Contract
[/TD]
[TD]Originator
[/TD]
[TD]Originator type
[/TD]
[TD]Zone
[/TD]
[/TR]
[TR]
[TD]1389
[/TD]
[TD]Central
[/TD]
[TD]1
[/TD]
[TD]Facility Maintenance
[/TD]
[TD]Repair Kindergarten
[/TD]
[TD]Kabul
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1390
[/TD]
[TD]Central
[/TD]
[TD]1
[/TD]
[TD]Facilities Lease
[/TD]
[TD]A Rental house for Addicates Hospital
[/TD]
[TD]Facilities
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1392
[/TD]
[TD]Central
[/TD]
[TD]1
[/TD]
[TD]Construction Works
[/TD]
[TD]37 lines of constructional materials
[/TD]
[TD]Kabul
[/TD]
[TD]Facilities
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1393
[/TD]
[TD]Central
[/TD]
[TD]1
[/TD]
[TD]Radios and Computers
[/TD]
[TD]Procuring 3 credit card
[/TD]
[TD]ICT
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1391
[/TD]
[TD]Central
[/TD]
[TD]1
[/TD]
[TD]Food (Class I)
[/TD]
[TD]2 lines of meat
[/TD]
[TD]Kabul
[/TD]
[TD]ANCOP
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1392
[/TD]
[TD]Regional
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD]procuring of 7 connex ( 3 connex 40 feetS and 4 connex 20 feets )
[/TD]
[TD]Nangahar
[/TD]
[TD]PHQ
[/TD]
[TD]202
[/TD]
[/TR]
[TR]
[TD]1390
[/TD]
[TD]Regional
[/TD]
[TD]1
[/TD]
[TD]Food (Class I)
[/TD]
[TD]Wheat Flour
[/TD]
[TD]Asmaye Zone
[/TD]
[TD]Zone
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1391
[/TD]
[TD]Regional
[/TD]
[TD]1
[/TD]
[TD]Construction Works
[/TD]
[TD]Const. of Power Station for 12th Police Dstrct
[/TD]
[TD]101 Asmaye Zone
[/TD]
[TD]Zone
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1393
[/TD]
[TD]Regional
[/TD]
[TD]1
[/TD]
[TD]Repair Services
[/TD]
[TD]Insulation
[/TD]
[TD]Faryab
[/TD]
[TD]prison
[/TD]
[TD]303
[/TD]
[/TR]
[TR]
[TD]1393
[/TD]
[TD]Central
[/TD]
[TD]2
[/TD]
[TD]Facilities Lease
[/TD]
[TD]Leasing house required by recuritment Department
[/TD]
[TD]Facilities
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1389
[/TD]
[TD]Central
[/TD]
[TD]2
[/TD]
[TD]Facility Maintenance
[/TD]
[TD]CID repairment
[/TD]
[TD]Kabul
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1392
[/TD]
[TD]Central
[/TD]
[TD]2
[/TD]
[TD]Construction Works
[/TD]
[TD]66 lines of constructional equipment
[/TD]
[TD]Kabul
[/TD]
[TD]Facilities
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1391
[/TD]
[TD]Central
[/TD]
[TD]2
[/TD]
[TD]Food (Class I)
[/TD]
[TD]7 lines of fresh fruit
[/TD]
[TD]Kabul
[/TD]
[TD]ANCOP
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1390
[/TD]
[TD]Central
[/TD]
[TD]2
[/TD]
[TD][/TD]
[TD]Build 4 floors block for martyrs & Disables House
[/TD]
[TD]Facilities
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/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]
[TD]101 Asmaye Zone
[/TD]
[TD]Zone
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1390
[/TD]
[TD]Regional
[/TD]
[TD]2
[/TD]
[TD]Food (Class I)
[/TD]
[TD]2 line items of raisins & food spices
[/TD]
[TD]Asmaye Zone
[/TD]
[TD]Zone
[/TD]
[TD]101
[/TD]
[/TR]
[TR]
[TD]1392
[/TD]
[TD]Regional
[/TD]
[TD]2
[/TD]
[TD][/TD]
[TD]procuring of 36 connex 20 feets
[/TD]
[TD]Paktia
[/TD]
[TD]ANCOP
[/TD]
[TD]505
[/TD]
[/TR]
[TR]
[TD]1393
[/TD]
[TD]Regional
[/TD]
[TD]2
[/TD]
[TD]Food (Class I)
[/TD]
[TD]28 Lines food materials
[/TD]
[TD]Faryab
[/TD]
[TD]prison
[/TD]
[TD]303
[/TD]
[/TR]
[TR]
[TD]1393
[/TD]
[TD]Central
[/TD]
[TD]3
[/TD]
[TD]Facilities Lease
[/TD]
[TD]Leasing house required by Meyers and disable Department
[/TD]
[TD]Facilities
[/TD]
[TD]Kabul
[/TD]
[TD]101
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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