Speed Up Formula for +3000 rows

B

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:

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
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:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Vlookup in Array rather than looping
Replies
4
Views
672
Norie
Norie

Forum statistics

Threads
1,214,391
Messages
6,119,244
Members
448,879
Latest member
VanGirl

Share this page

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