Speed Up Formula for +3000 rows

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi,

I am trying to check to see if two cells in Sheets("CHECKING") or (ws2), correspond with values in Sheets("Category Hierarchy (5)") or ws3. In row 1 of ws3 there are "Departments" and below that department from row 2 onwards are categories and these categories are unique values to only one department.

The value in Cell.offset(0,-2) is the category and the value in cell.offset(0,-3) is the department. We need to make sure that the category in ws2 in the column of the matched department in ws3. i.e. make sure there is not a mismatched category to a department.

The following code works fine but it takes a long time to loop through all the cells in rng1.

Is there a quicker way to increase speed? See below for code and samples of data from both ws.
Code:
Sub test()


Dim rng, catrng As Range
Dim ws As Worksheet


Set ws2 = Sheets("CHECKING")
    Set rng1 = Range(ws2.Cells(1, 6), ws2.Cells(1, 6).End(xlDown))
    
    For Each cell In rng1
    Set ws3 = Sheets("CATEGORY HIERARCHY (" & cell.Offset(0, -1).Value & ")")
        If Not cell.Offset(0, 2) = 0 Or IsError(Application.Match(cell.Offset(0, -3).Value, ws3.Rows("1:1"), 0)) Then
            ws2.Cells(i, 8) = "0"
        Else
            x = Application.WorksheetFunction.Match(cell.Offset(0, -3), ws3.Rows("1:1"))
            Set catrng = Range(ws3.Cells(2, x), ws3.Cells(1000, x))
            If IsError(Application.VLookup(cell.Offset(0, -2), catrng, 1, False)) Then
                cell.Offset(0, 4) = "1"
            Else
                cell.Offset(0, 4) = "0"
            End If
        End If
    Next cell


End Sub

Here is some sample data from ws2:
Icy HotPrivate LabelHealth & BeautyFirst Aid Essential Oils/Lotions5548Icy HotPrivate LabelHealth & BeautyFirst Aid Essential Oils/Lotions5000
Signature HomePrivate LabelHousehold ProductsToilet Cleaners5577Signature HomePrivate LabelHousehold ProductsToilet Cleaners5000
Signature HomePrivate LabelGeneral MerchandiseHousehold Gloves5577Signature HomePrivate LabelGeneral MerchandiseHousehold Gloves5000
CrestProcter & GambleHealth & BeautyToothbrush - Pwr5578CrestProcter & GambleHealth & BeautyToothbrush - Pwr5000
SoleilOther MfrHealth & BeautyRazors & Blades5602SoleilOther MfrHealth & BeautyRazors & Blades5000
Irish SpringOther MfrHealth & BeautyLiquid Soap5609Irish SpringOther MfrHealth & BeautyLiquid Soap5000
PondsUnileverHealth & BeautyFacial Tissues5613PondsUnileverHealth & BeautyFacial Tissues5000
Just For MenOther MfrHealth & BeautyColourants5626Just For MenOther MfrHealth & BeautyColourants5000
BioteneGlaxoSmithKlineHealth & BeautyToothpaste5662BioteneGlaxoSmithKlineHealth & BeautyToothpaste5000
Dentu-CrèmeGlaxoSmithKlineHealth & BeautyDenture Care5662Dentu-CrèmeGlaxoSmithKlineHealth & BeautyDenture Care5000
Love Beauty & PlanetUnileverHealth & BeautyCream / Lotion5707Love Beauty & PlanetUnileverHealth & BeautyCream / Lotion5000
MotrinOther MfrHealth & BeautyAnalgesics5711MotrinOther MfrHealth & BeautyAnalgesics5000
BengayOther MfrHealth & BeautyMedicinal5711BengayOther MfrHealth & BeautyMedicinal5000
One A DayBayerHealth & BeautyDigestive Remedies5716One A DayBayerHealth & BeautyDigestive Remedies5000
DoveOther MfrHealth & BeautyShamp, Cond & Treat5735DoveOther MfrHealth & BeautyShamp, Cond & Treat5000
AjaxColgate PalmoliveHousehold ProductsDishwashing - Manual5779AjaxColgate PalmoliveHousehold ProductsDishwashing - Manual5000
SuavitelColgate PalmoliveHousehold ProductsFabric Care5779SuavitelColgate PalmoliveHousehold ProductsFabric Care5000
FabulosoColgate PalmoliveHousehold ProductsFabric Care5779FabulosoColgate PalmoliveHousehold ProductsFabric Care5000
MurphysOther MfrHealth & BeautyLiquid Soap5779MurphysOther MfrHealth & BeautyLiquid Soap5000
TylenolJohnson & JohnsonHealth & BeautyMedicinal5809TylenolJohnson & JohnsonHealth & BeautyMedicinal5000
Simply SleepOther MfrHealth & BeautyVitamins5813Simply SleepOther MfrHealth & BeautyVitamins5000
Nature BountyOther MfrHealth & BeautyVitamins5844Nature BountyOther MfrHealth & BeautyVitamins5010
Top CareOther MfrHealth & BeautyDigestive Remedies5896Top CareOther MfrHealth & BeautyDigestive Remedies5000
DuoOther MfrHealth & BeautyCosmetics5902DuoOther MfrHealth & BeautyCosmetics5000
OGXOther MfrHealth & BeautyLiquid Soap5906OGXOther MfrHealth & BeautyLiquid Soap5000
Up & UpPrivate LabelHealth & BeautyFacial Tissues5930Up & UpPrivate LabelHealth & BeautyFacial Tissues5000

<colgroup><col width="64" span="10" style="width:48pt"> </colgroup><tbody>
</tbody>




Here the sample data from ws3:
DepartmentsBaby NeedsBakeryBeveragesChilled FoodDry GroceryFrozen ProductsFruit & VegetablesGeneral MerchandiseHealth & BeautyHousehold ProductsLiquorMeat FreshNewsagency / TobaccoPetcareRetailer ContentSnacking
CategoriesBaby AccessoriesBakeryCoffee SubstitutesChilled BreadAsian FoodsFish FingersFruit & VegetablesAppliancesAccessoriesAir FreshenersLiquorMeat FreshFlowersBirdsRetailer ContentConfect Bars
Baby Food & FormulaCordialChilled CheeseBaked Beans/SpaghettiFrozen Chk/Turk/DuckAudioAnalgesicsBleachMagazinesChilled PetfoodConfect Bitesize
Baby NeedsHome BrewingChilled DipsBottled SaucesFrozen Finger FoodsBagsAntisepticsDishwashing - AutoNewspapersDog TreatsConfect Gifting
NappiesHot BeveragesChilled FishCake NeedsFrozen SavouriesBakewareAt Home WhiteningDishwashing - ManualLitterConfect Gum
Milk ModifiersChilled Noodles & SauceCanned FruitFrozen SnacksBooksBar SoapDisinfectantOther PetsConfect Pre Teen
Powdered Milk / Coffee WhitenersDeli DipsCanned MealsFrozen Pizza - PremiumBuckets & BinsColourantsFabric CarePet AccessoriesConfect Refresh
TeaDeli Fresh MealsCanned MeatFrozen FishCampingCondoms/LubricantsGarbage BagsPet HealthConfect Seasonal
Ambient JuiceDeli SaladCereal - AdultFrozen DessertsClothingCosmeticsHousehold CleanersPet ToysConfect Sharepacks
CoffeeEggsChutney Pickles RelishFrozen MealsCrockeryCotton ProductsHousehold Cleaning - BrushwareCatfoodNutritional Bars
CSDEntertaining Antipasto/CondCones Wafers CupsFrozen PastryDVDsDental FlossInsecticidesDogfoodNutritious Snacks
Energy DrinksFresh CreamCooking ChocolateFrozen PotatoElectrical FittingsDenture CareLaundry Det - LiqNuts
Lifestyle DrinksFresh CustardCooking NutsFrozen VegElectricalsDeodorantsLaundry Det - PwdShelf Stable Dips
Long Life BeveragesFresh Pasta & SauceDried FruitIce CreamFilmDepilatoriesPaper TowelsBiscuits
Mineral WaterSmallgoodsDry PastaFrozen PizzaFitness EquipmentDigestive RemediesPrewashSalty Snacks
Sports DrinksChilled JuiceEthnic Gourmet FoodsGarden CareFacial TissuesPlastic Bags/Wraps/FoilsChocolate Blocks
Still WaterFresh MilkHampersGift CardsFeminine HygieneSponges Scourers & WipesCandy Bags
Yellow SpreadsHealth FoodsGiftsFirst Aid Essential Oils/LotionsToilet Cleaners
Yoghurt / DessertHealthfoods Diet Sport ProductsGlasswareFirst Aid FootcareToilet Tissues
Herbs & SpicesHome HardwareFragrancesFire Needs
Hot PacksHomewaresGift Packs
Indian FoodsHosieryHair Care - Styling
JellyHousehold GlovesLiquid Soap
Mexican Food*******wareMedicinal
Noodles - CookingLaundry NeedsMens Aftershaves/Cologne
Noodles - SnackLight GlobesMens Hair Care
Pasta CheeseManchesterMens Skin Care
Pasta SaucesMotoringMouth Wash
Pasta Sauces - IngredientsOutdoorNail Care
Pickled VegetablesParty and Picnic NeedsPregnancy Kits
PicnicwareParty Wrap and FoilShamp, Cond & Treat
Recipe BasesPhonesShaving Preparations
RiceSeasonal DecorationsShower Gel
SaltStationerySun Care
Sauces And GravyToysTalc
Shelf Stable DessertContainersToothbrush - Man
Side DishesBatteriesToothbrush - Pwr
Simmer SaucesToothpaste
SugarTravel Toiletries
Sugar SubstitutesNicotine
ToppingsAntifungal
VinegarAnthelmintics
Water IcesOptical
Wet MustardsHair Loss
Baking MixesLice Treatment
Can FishAdult Incontinence
Can VegCream / Lotion
Breakfast CerealRazors & Blades
Cooking OilUpper Respiratory Tract
Flour / Bread MixesVitamins
Mayo & Dressing
Spreads
Soup
Stock

<colgroup><col width="64" span="17" style="width:48pt"> </colgroup><tbody>
</tbody>
 
Last edited by a moderator:

=ODIN=

Active Member
Joined
Dec 3, 2009
Messages
288
Have you worked with arrays in VBA yet?

If not, that is what you should start researching.

Since excel 2007 and beyond, cycling through cells in a range has been extremely slow, so the best practice is to load a range of cells to an array, all at once. Do whatever work needs to be done within excel's memory without touching cells on a sheet. Then finally load back to the sheet the output all at once.

Below is a simple demo of how that might work.

Code:
Sub arrExample()
'load array in and spit array out


arr = Range("a1:b3") 'load range into 2d array 'arr becomes a 2 dimensional array loaded with the range's values


'processing the range could happen here



Range("c4:d6") = arr  'export the 2d array back to a different range






End Sub
 
Last edited:

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi Odin,

I am completely self taught in VBA and I have been googling and looking at videos on how to accomplish this but it is all going a bit over my head.

Would you mind giving me some more detail in your answer and using the formulas I have above.

I would be very appreciative if you could.

Thanks
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,579
Office Version
365
Platform
Windows
How about
Code:
Sub bayles()
   Dim CatAry As Variant
   Dim Dic As Object
   Dim r As Long, c As Long
   Dim Cl As Range
   
   Application.ScreenUpdating = False
   
   CatAry = Sheets("Category Hierarchy (5)").Range("A1").CurrentRegion.Value2
   Set Dic = CreateObject("scripting.dictionary")
   
   For c = 2 To UBound(CatAry, 2)
      Dic.Add CatAry(1, c), CreateObject("scripting.dictionary")
      For r = 2 To UBound(CatAry)
         Dic(CatAry(1, c))(CatAry(r, c)) = Empty
      Next r
   Next c
   
   With Sheets("Checking")
      For Each Cl In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then
            Cl.Offset(, 7).Value = 1
         ElseIf Not Dic(Cl.Value).Exists(Cl.Offset(, 1).Value) Then
            Cl.Offset(, 7).Value = 1
         Else
            Cl.Offset(, 7).Value = 0
         End If
      Next Cl
   End With
End Sub
 

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Thanks so much Fluff.

That was great. I'll try to learn from this code as to how to implement arrays. I can usually fluke my way through it eventually.

Cheers
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,579
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,085,200
Messages
5,382,286
Members
401,781
Latest member
lozzeroooni

Some videos you may like

This Week's Hot Topics

Top