Loop through 3000 rows + 5 columns and change data

bayles · Feb 13, 2019

G'day,

I have data in a master sheet (BvTrax) which I am trying to compare to another sheet (DUPLICATED BRANDS) where I have made some suggested corrections.

I have created a string of multiple cell values in the master sheet (BvTrax) to compare to the corrections sheet (DUPLICATED BRANDS). If 2 cells in that row contain corrections then overwrite the changes in master.

The number of rows does vary and at the moment I have about 3000 rows but it is grinding to a halt. It all appears to work ok at the moment, I just need to speed it up.

I am positive there is a quicker method but my limited skills cannot do it.

Thanks
Ryan

Dim Cell, crng As Range
Dim WS As Worksheet
Set WS1 = Sheets("BvTrax")
Set WS2 = Sheets("DUPLICATED BRANDS")
' FIND FIRST AND LAST ROW OF DATA
firstrow = WS1.Cells.Find(What:="Description", After:=WS1.Range("A1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Offset(1, 0).row ' FIND ROW NUMBER OF DATA

BranCol = WS1.Cells.Find(What:="BRAND1", After:=WS1.Cells(firstrow, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column ' THE COLUMN OF BRAND 1

regionID = WS1.Cells.Find(What:="regionID", After:=WS1.Cells(firstrow, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column ' THE REGION ID

first = firstrow
Do Until WS1.Cells(first, 1) = ""

first = first + 1

Loop
lastrow = first ' FIND THE LAST ROW WITH DATA

Set crng = WS2.Range("G:G") ' RANGE IN DUPLICATED BRANDS WITH MATCHING CONCATENATE FORMULA

' CYCLE THROUGH AND CHECK EACH CELLS AND MAKE CORRECTIONS
i = firstrow
x = 0
Do Until x = 6
Do Until i = lastrow
concatenate = WS1.Cells(i, regionID) & WS1.Cells(i, BranCol + x) & WS1.Cells(i, BranCol + 5 + x) & WS1.Cells(i, BranCol + 10 + x) & WS1.Cells(i, BranCol + 15 + x)
If concatenate <> "" Then
For Each Cell In crng
If Cell.Value = concatenate Then
If Cell.Offset(0, 1) <> "" Then
WS1.Cells(i, BranCol + x) = Cell.Offset(0, 1) ' copy new brand
End If
If Cell.Offset(0, 2) <> "" Then
WS1.Cells(i, BranCol + 5 + x).Value = Cell.Offset(0, 2).Value ' copy new manufacturer
End If
Exit For
End If
Next Cell
End If
i = i + 1
Loop

x = 1
Loop

Akuini · Feb 13, 2019

Could you post your sample data in both sheet as table?
Reading your code, I’m not sure how you “compare“ & “correcting”, so please explain using an example.

bayles · Feb 13, 2019

Akuini, thanks for taking a look for me.

Here is some sample data from BvTrax sheet

RecordID

Catalogue_Theme

Date

Catalogue_Start_Date

Catalogue_End_Date

Retailer

Description

Page_No

Promo_Type

Multi Qty

Price

Brand1

Brand2

Brand3

Brand4

Brand5

Manufacturer1

Manufacturer2

Manufacturer3

Manufacturer4

Manufacturer5

Department1

Department2

Department3

Department4

Department5

Category1

Category2

Category3

Category4

Category5

RegionId

########

Save Big Now!

########

Dollar General

Any Ivory Bar Soap 3 ct.

13

Price Reduction

0.00

4.25

Ivory

Other Mfr

Health & Beauty

Bar Soap

5

########

Summer Base Camp for essentials

########

Walgreens - IL

Dial ,Body Wash, 16 oz, Bar Soap, 6 or 8 pk,buy 1 get 1 free* with card

16

BOGOF

0.00

Dial

Henkel

Other Mfr

Health & Beauty

Shower Gel

Bar Soap

5

########

Extra Savings Non Foods

########

Publix

$1 off Olay or lvory Body wash Pumps 16.9 oz. or 30 oz.

7

Price Reduction

0.00

Olay

Ivory

Procter & Gamble

Other Mfr

Health & Beauty

Shower Gel

5

########

Coupon Savings

########

Publix

$1.00 off Any One (1) Dove Hair Care 3.3 - 12 oz Body Wash, Foam or Polish 10.5 - 34 oz. Dove 6 Bar or Dove Deodorant 1.7 - 5.2 oz. Limit one coupon per household per day. Customer is responsible for all applicable taxes. Reproduction or transfer of this coupon is strictly prohibited. Offer good through 8/24/18 at your neighborhood Publix. Coupon valid August 11 - August 24, 2018. LU 11291

5

Coupon

0.00

Dove

Unilever

Other Mfr

Health & Beauty

Shamp, Cond & Treat

Shower Gel

Bar Soap

Deodorants

5

########

Extra Savings Non Foods

########

Publix

$1.00 off Any One (1) Dove, Dove Men+Care or Caress Shower Foam 13.5 oz.

5

Coupon

0.00

Dove

Caress

Unilever

Health & Beauty

Shower Gel

5

########

Coupon Savings

########

Publix

$1.00 off Any One Dove, Dove Men+Care or Caress Shower Foam 13.5 oz. Limit one coupon per household per day. Customer is responsible for all applicable taxes. Reproduction or transfer of this coupon is strictly prohibited. Offer good through 9/21/18 at your neighborhood Publix. Coupon valid September 8 - September 21, 2018. LU 11133

4

Coupon

0.00

Dove

Caress

Unilever

Other Mfr

Health & Beauty

Shower Gel

5

########

Extra Savings Non Foods

########

Publix

$1.00 off ON ANY TWO (2) MIX or MATCH: Suave Hair Care 4.3 - 30 oz., Lotion 18 oz. Body Wash 12.6 - 15 oz. or Deodorant 2.6 oz.

4

Coupon

2.00

0.00

Suave

Other Mfr

Health & Beauty

Shamp, Cond & Treat

Cream / Lotion

Shower Gel

Deodorants

5

########

coupon savings

########

Publix

$1.00 off ON ANY TWO (2) MIX or MATCH: Suave Hair Care 4.3 - 30 oz Deodorant 2.6 oz. or Body Wash or Lotion 15 - 18 oz.

5

Coupon

2.00

0.00

Suave

Other Mfr

Health & Beauty

Shamp, Cond & Treat

Deodorants

Cream / Lotion

Shower Gel

5

And here is the sample data from DUPLICATED BRANDS

Region	Department	Category	Subcategory	Brand	Manufacturer	Concanenate	Brand	Manufacturer
5	Health & Beauty	Personal Wash	Bar Soap	Dial	Henkel	5DialHenkelHealth & BeautyBar Soap
5	Health & Beauty	Personal Wash	Bar Soap	Dial	Other Mfr	5DialOther MfrHealth & BeautyBar Soap		Henkel
5	Health & Beauty	Personal Wash	Liquid Soap	Dial	Henkel	5DialHenkelHealth & BeautyLiquid Soap
5	Health & Beauty	Personal Wash	Liquid Soap	Dial	Other Mfr	5DialOther MfrHealth & BeautyLiquid Soap		Henkel
5	Health & Beauty	Personal Wash	Shower Gel	Dial	Henkel	5DialHenkelHealth & BeautyShower Gel
5	Health & Beauty	Personal Wash	Shower Gel	Dial	Other Mfr	5DialOther MfrHealth & BeautyShower Gel		Henkel

bayles · Feb 13, 2019

I'm sorry I am having issues pasting as a table. Hopefully that is ok for you to debug.

When I say comparing what I am actually doing is looking for the concatenate and then if there has been a corrected Brand or Manufacturer entered in Duplicated Brands sheet, then we replace the corresponding data in the BvTrax sheet.

Akuini · Feb 14, 2019

If 2 cells in that row contain corrections then overwrite the changes in master.

What do you mean by “2 cells in that row contain corrections”, 2 cells in what column?, what is “corrections”?

Sorry, it's hard for me to understand what you're trying to do.
It would help if you can use an example, say row 3 where there are:
in col L-M: Dial Dial
in col Q-R: Henkel Other Mfr

what should happen to those cells and why?
and describe step by step what you're trying to do.

bayles · Feb 14, 2019

Hi Akuini,

Sorry i didn't want to explain too much and over complicate things but I have gone too simplistic.

What I am trying to do is this.
1. Firstly compare the data combination in L,Q,V,AA,AG in ws1 and see if it is present in ws2 column G.

2. In ws2 I have created a concatenate formula for these same variables in column G. Perhaps this formula isn't necessary and we can search the combination in columns A:G (although the order needs to be A,E,F,B,D to have the same method of calculation as ws1 combination).

3. In some instances the combination in step 1 needs to be adjusted. Either L and / or Q will be changed in ws1 with values in ws2 H or I depending if there is a value or not. If columns H and I are blank then change nothing.

4. Once L,Q,V,AA,AG has been completed we will then run the same calculation for M,R,W,AB,AG combination for the same ranges in ws2.

5. We would then do this another 3 times for a grant total of 5 times L,M,N,O,P columns and their corresponding values.

Please let me know if this is not clear enough or something needs more information.

Thanks again for your help. I am eager to understand how to make this type of process quicker as I deal with some large data sets and my limited knowledge is only getting me so far.

Akuini · Feb 15, 2019

OK, try this:
Note:
If you want to format the cell font with blue where the cells has changed by the code, you can comment out these 2 lines:

'Cells(i, j + 11).Font.Color = vbBlue

and

'Cells(i, j + 16).Font.Color = vbBlue

Code:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1087420a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1087420-loop-through-3000-rows-5-columns-change-data.html[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] cnt [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, z
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] WS1 [COLOR=Royalblue]As[/COLOR] Worksheet, WS2 [COLOR=Royalblue]As[/COLOR] Worksheet

[COLOR=Royalblue]Set[/COLOR] WS1 = Sheets([COLOR=brown]"sheet1"[/COLOR])
[COLOR=Royalblue]Set[/COLOR] WS2 = Sheets([COLOR=brown]"sheet2"[/COLOR])

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]With[/COLOR] WS2
    n = .Range([COLOR=brown]"A"[/COLOR] & .Rows.Count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
    va = .Range([COLOR=brown]"G2:I"[/COLOR] & n)
    [COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
    d.CompareMode = vbTextCompare
    [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]If[/COLOR] Len(va(i, [COLOR=crimson]2[/COLOR])) + Len(va(i, [COLOR=crimson]3[/COLOR])) <> [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        d(va(i, [COLOR=crimson]1[/COLOR])) = Trim(va(i, [COLOR=crimson]2[/COLOR])) & [COLOR=brown]"::"[/COLOR] & Trim(va(i, [COLOR=crimson]3[/COLOR]))
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]

WS1.Activate

n = Range([COLOR=brown]"A"[/COLOR] & Rows.Count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
va = Range([COLOR=brown]"L1:AG"[/COLOR] & n)
x = [COLOR=crimson]0[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])

    [COLOR=Royalblue]For[/COLOR] j = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]5[/COLOR]
    cnt = va(i, [COLOR=crimson]22[/COLOR]) & va(i, j) & va(i, j + [COLOR=crimson]5[/COLOR]) & va(i, j + [COLOR=crimson]10[/COLOR]) & va(i, j + [COLOR=crimson]15[/COLOR])
    
        [COLOR=Royalblue]If[/COLOR] d.Exists(cnt) [COLOR=Royalblue]Then[/COLOR]
        
        z = Split(d(cnt), [COLOR=brown]"::"[/COLOR])
        
            [COLOR=Royalblue]If[/COLOR] z([COLOR=crimson]0[/COLOR]) <> [COLOR=brown]""[/COLOR] [COLOR=Royalblue]Then[/COLOR]
                Cells(i, j + [COLOR=crimson]11[/COLOR]) = z([COLOR=crimson]0[/COLOR])
                [I][COLOR=seagreen]'Cells(i, j + 11).Font.Color = vbBlue[/COLOR][/I]
                x = x + [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
        
            [COLOR=Royalblue]If[/COLOR] z([COLOR=crimson]1[/COLOR]) <> [COLOR=brown]""[/COLOR] [COLOR=Royalblue]Then[/COLOR]
                Cells(i, j + [COLOR=crimson]16[/COLOR]) = z([COLOR=crimson]1[/COLOR])
                [I][COLOR=seagreen]'Cells(i, j + 16).Font.Color = vbBlue[/COLOR][/I]
                x = x + [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]

[COLOR=Royalblue]Next[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
MsgBox x & [COLOR=brown]" cells value have been changed"[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR]

[/FONT]

Loop through 3000 rows + 5 columns and change data

bayles

Board Regular

Excel Facts

Akuini

Well-known Member

bayles

Board Regular

bayles

Board Regular

Akuini

Well-known Member

bayles

Board Regular

Akuini

Well-known Member

Similar threads

Forum statistics

Share this page

Loop through 3000 rows + 5 columns and change data

bayles

Board Regular

Excel Facts

Akuini

Well-known Member

bayles

Board Regular

bayles

Board Regular

Akuini

Well-known Member

bayles

Board Regular

Akuini

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock