Search duplicate rows based on 3 columns in all worksheets and update

[PritishS]

Dear Sir/Madam,

Hope you are doing well!

I'm stuck with a new kind a problem.
Details:
I have a worksheet name 'MAT', which is basically a bill of material having columns 'Description', 'Make', 'CatNo' and 'Price'.

Description make CatNo Price
Pencil1 ABC PEN1 100
Pencil2 WER PEN2 123
Ruler1 QAS RUL1 50

Also I have 2 worksheet before 'MAT' named 'Pencil' and 'Ruler', containing database of all pencils and rulers. Those Sheets also have same column like 'Description', 'Make', 'CatNo' and 'Price'. These tables Price I update in regular interval.

Table: Pencil

Description make CatNo Price
Pencil1 ABC PEN1 105
Pencil2 WER PEN2 145
Pencil3 FCD PEN3 121
Pencil4 FCE PEN4 111

Table: Ruler
Description make CatNo Price
Ruler1 QAS RUL1 58
Ruler2 WER RUL2 55
Ruler3 FCD RUL3 32
Ruler4 FCE RUL4 15

Now I need a program, which will Start checking 'MAT' sheet form Row having Pencil1 and check in all two sheets and if found same component 'Pencil1' & 'ABC' & 'PEN1' in any sheet, it will print the price from that sheet to 'MAT' sheet in front of Pencil1 in 'New Price' column.

It's like in 'MAT' sheet

Description make CatNo Price New Price
Pencil1 ABC PEN1 100 105
Pencil2 WER PEN2 123 145
Ruler1 QAS RUL1 50 58

Now here what I have tired and got partial success:

Sub updateprice()

    Dim intRow1 As Integer
    Dim intRow2 As Integer
    Dim strNameSurname1 As String
    Dim strNameSurname2 As String
    
    intRow1 = 7 'The first row the data starts
    intRow2 = intRow1 + 1

    With Worksheets("BOM")
        Do While .Cells(intRow1, 1).Value <> Empty
            Do While .Cells(intRow2, 1).Value <> Empty
                strNameSurname1 = CStr(.Cells(intRow1, 1).Value) & CStr(.Cells(intRow1, 2).Value) & CStr(.Cells(intRow1, 3).Value)
                strNameSurname2 = CStr(.Cells(intRow2, 1).Value) & CStr(.Cells(intRow2, 2).Value) & CStr(.Cells(intRow2, 3).Value)
                If strNameSurname1 = strNameSurname2 Then
                    .Cells(intRow1, 5).Value = .Cells(intRow2, 4).Value '.Cells(intRow1, 4).Value
                   
                End If
                intRow2 = intRow2 + 1
            Loop
            intRow1 = intRow1 + 1
            intRow2 = intRow1 + 1
        Loop
    End With
End Sub

It updates the price if only the same records available in MAT sheet. Like-

Description make CatNo Price New Price
Pencil1 ABC PEN1 100 105
Pencil2 WER PEN2 123 145
Ruler1 QAS RUL1 50 58
Pencil1 ABC PEN1 105
Pencil2 WER PEN2 145
Ruler1 QAS RUL1 58

Basically, this code starts from Row 7 , concatenate 'Pencil1'&'ABC'&'PEN1' and checks for rows down. If found same concatenated record in below row it takes the Price of duplicate row and updates price in col-'New Price' of first row.

But I want this searching to be start from first sheet to all sheets except 'MAT' and if price found then update to col-"New Price' then go for next row of 'Pencil2' and again search into all worksheet and do this operation till the last row of MAT Sheet.

Hope my requirement is clear. I'm using Excel 2007 and Windows7 laptop.

I'll be grateful for any help.

Thanks & Regards,
PritishS

 

[MickG]

Try this for Data update on sheet "Mat"

[COLOR="Navy"]Sub[/COLOR] MG22May21
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] str [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] shts [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant, s [COLOR="Navy"]As[/COLOR] Variant
 [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
  shts = Array("Mat", "Pencil", "Ruler")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] s [COLOR="Navy"]In[/COLOR] shts
    [COLOR="Navy"]With[/COLOR] Sheets(s)
        [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]With[/COLOR] Application
        str = Join(.Transpose(.Transpose(Dn.Resize(, 3))), ",")
    [COLOR="Navy"]End[/COLOR] With
        [COLOR="Navy"]If[/COLOR] Not .Exists(str) [COLOR="Navy"]Then[/COLOR]
            .Add str, Array(Dn, 3)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(str)
            Q(1) = Q(1) + 1
            Q(0).Offset(, Q(1)) = Dn.Offset(, 3)
            .Item(str) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Next[/COLOR] s
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[PritishS]

Hi Mick,

Thanks a lot for your time!! I am try your suggestion now and let you know.

Thanks,
PritishS

 

[PritishS]

Hi Mick,

I just tried you code and it's resolved my problem 80%!! Thanks a lot!
Just 2 quires,
1. I added a new sheet named 'Lamp' (its same as 'Pencil' and 'Ruler') and added some data from 'Lamp' to 'MAT'. When I run this code, it updates the price of 'Pencil' and 'Ruler' but not the data which I added from sheet "Lamp'. So how to include more sheets? Actually I have around 90 worksheets.

2. Also it is checking the 'MAT' sheet too. I only wanted to check all sheets except 'MAT'('MAT' will always will be the last sheet of this workbook)

Please guide me.

Thanks,
PritishS

 

[MickG]

Also it is checking the 'MAT' sheet too. I only wanted to check all sheets except 'MAT'('MAT' will always will be the last sheet of this workbook)

From your first post you state that sheet "Mat" is he sheet that is to be updated from the other sheets. If this is now not the case what is the sheet name that is to be updated.
In the code, sheet "Mat" is the sheet that is updated with the info from the other sheets.!!!!

If you have approx 90 sheet that are to looped through, it would be better to loop through them as a collection rather than naming them individually. To this end, are there sheets in the workbook that do not need to be looped through, If so what are there names.

 

[PritishS]

Hi Mike,
Have a Nice Day!

I'm sorry if I was not able to clarify myself in the first post. Actual scenario is,

I have total 90 Sheet. 89 sheets are database/item table (like-pencil, ruler, pin, scissors etc.). From those tables I select data and create Bill of material on 'MAT' sheet. As I said column structure is same for all sheets ('Description', 'Make', 'CatNo' and 'Price').
Lets take an example,If I have made a Bill of material in 'MAT' sheet (which is 90th/last sheet and always will be) 1 month ego. By today, many prices have revised time to time in 1 to 89 sheets (like-pencil, ruler, pin, scissors etc.) in this 1 month.
Now today I want to open the 'MAT' sheet and click on 'Update Price' button (where I have assigned your code), It should check from 1 to 89 sheets and update the components price in 'MAT' sheet in 5 column.

This is a sample Bill of material

Description Make CatNo Price New Price
Pencil1 ABC PEN1 100
Pencil2 WER PEN2 123
Ruler1 QAS RUL1 50


As I said, your code is doing great. It is certainly updating price in 'New Price' column but it starting it's search from 'MAT' sheet.

Here I have just repeated first row while testing your code. Consider in 'Pencil' sheet, that Pencil1's (with Make-ABC and Catno-PEN1) price is now 105. Then I ran the code

Description Make CatNo Price New Price
Pencil1 ABC PEN1 100
Pencil2 WER PEN2 123
Ruler1 QAS RUL1 50
Pencil1 ABC PEN1 100

Now the result is showing--

Description Make CatNo Price New Price Column-6
Pencil1 ABC PEN1 100 100 105
Pencil2 WER PEN2 123
Ruler1 QAS RUL1 50
Pencil1 ABC PEN1 100

I observed this code is first looking through the MAT sheet and update the price of Pencil1 (which I have repeated in row4). Then it went to the 'Pencil' Sheet and searched that component 'Pencil1' and updated its price on 'MAT' sheet.

So my question is can I run the searching method through all worksheets except the last one 'MAT' and update the components available in 'MAT' sheet with the latest price from other sheets?

If you have approx 90 sheet that are to looped through, it would be better to loop through them as a collection rather than naming them individually. To this end, are there sheets in the workbook that do not need to be looped through, If so what are there names.

Also, I'm still a novice in macro programing. Can you guide me how to loop through them as collection rather than naming them individually?

To this end, are there sheets in the workbook that do not need to be looped through, If so what are there names.

Yes, only the last sheet 'MAT' (which will always will be last sheet), which is to only be updated, not to be looped through.

Once again thank a lot for your helping hand. You code really gave me a hope that my requirement is possible.

Thanks & Regards,
PritishS

 

[MickG]

I'm not quite sure how the code updated sheet "Mat", no matter, I have rewritten the code to loop through all worksheets and Update sheet "Mat". see below:-

[COLOR="Navy"]Sub[/COLOR] MG23May36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] str [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sht [COLOR="Navy"]As[/COLOR] Worksheet, Q [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
  [COLOR="Navy"]With[/COLOR] Sheets("Mat")
        [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]With[/COLOR] Application
            str = Join(.Transpose(.Transpose(Dn.Resize(, 3))), ",")
            Dic(str) = Array(Dn, 3)
        [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] sht [COLOR="Navy"]In[/COLOR] ActiveWorkbook.Worksheets
    [COLOR="Navy"]If[/COLOR] Not sht.Name = "Mat" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]With[/COLOR] sht
            [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
        [COLOR="Navy"]End[/COLOR] With
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]With[/COLOR] Application
            str = Join(.Transpose(.Transpose(Dn.Resize(, 3))), ",")
            [COLOR="Navy"]If[/COLOR] Dic.exists(str) [COLOR="Navy"]Then[/COLOR]
            Q = Dic(str)
            Q(1) = Q(1) + 1
            Q(0).Offset(, Q(1)) = Dn.Offset(, 3)
            Dic(str) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] With
       [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] sht
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[PritishS]

Hi Mike,

Thank you very much. Let me try this and I'll update you as soon as possible.

Thanks,
PritishS

 

[PritishS]

Hi Mike,

Thank you very much for resolving my two doubts.
a. Considering all worksheets with loop rather than name individually- Solved
b. Check all worksheets except last sheet-'MAT'- Solved.


With all due respect, I just want to bring our kind notice on a small issue. I guess I'm almost reached my destination and it's 95%.

In 'MA

Description	Make	CatNo	Price	New Price
Pencil1	ABC	PEN1	100
Pencil2	WER	PEN2	123
Ruler1	QAS	RUL1	50

<tbody>
</tbody>

T' sheet my Bill of material is like







Now the latest price of Pencil1 in table/sheet 'Pencil' is 150, Pencil2 is 160. Now I ran your code.

Result: As expected

Description	Make	CatNo	Price	New Price
Pencil1	ABC	PEN1	100	150
Pencil2	WER	PEN2	123	160
Ruler1	QAS	RUL1	50

<tbody>
</tbody>

Now I just added same Pencil1 and Pencil2 in next 2 row

Description	Make	CatNo	Price	New Price
Pencil1	ABC	PEN1	100
Pencil2	WER	PEN2	123
Ruler1	QAS	RUL1	50
Pencil1	ABC	PEN1	100
Pencil2	WER	PEN2	123

<tbody>
</tbody>

and ran this code.
Result:

Description	Make	CatNo	Price	New Price
Pencil1	ABC	PEN1	100
Pencil2	WER	PEN2	123
Ruler1	QAS	RUL1	50
Pencil1	ABC	PEN1	100	150
Pencil2	WER	PEN2	123	160

<tbody>
</tbody>

That means it updates the price of end records if same components are already been used.


expected result:

Description	Make	CatNo	Price	New Price
Pencil1	ABC	PEN1	100	150
Pencil2	WER	PEN2	123	160
Ruler1	QAS	RUL1	50
Pencil1	ABC	PEN1	100	150
Pencil2	WER	PEN2	123	160

<tbody>
</tbody>

that means all Pencil1 and Pencil2 must be updated with new Price from its table no matter how many times they appear in this Bill of Material.

I guess I'm almost near to find the destination. Please help me and guide me.

Once again thanks a lot for your valuable time.
Have a Nice Day!

Thanks & Regards,

PritishS

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG24May49
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] str [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sht [COLOR="Navy"]As[/COLOR] Worksheet, Q [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object, R [COLOR="Navy"]As[/COLOR] Range
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
  [COLOR="Navy"]With[/COLOR] Sheets("Mat")
        [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]With[/COLOR] Application
            str = Join(.Transpose(.Transpose(Dn.Resize(, 3))), ",")
         [COLOR="Navy"]End[/COLOR] With
                [COLOR="Navy"]If[/COLOR] Not Dic.exists(str) [COLOR="Navy"]Then[/COLOR]
                    Dic.Add (str), Array(Dn, 3)
                [COLOR="Navy"]Else[/COLOR]
                    Q = Dic(str)
                    [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
                    Dic(str) = Q
             [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] sht [COLOR="Navy"]In[/COLOR] ActiveWorkbook.Worksheets
    [COLOR="Navy"]If[/COLOR] Not sht.Name = "Mat" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]With[/COLOR] sht
            [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
        [COLOR="Navy"]End[/COLOR] With
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]With[/COLOR] Application
            str = Join(.Transpose(.Transpose(Dn.Resize(, 3))), ",")
            [COLOR="Navy"]If[/COLOR] Dic.exists(str) [COLOR="Navy"]Then[/COLOR]
                Q = Dic(str)
                    Q(1) = Q(1) + 1
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Q(0)
                        R.Offset(, Q(1)) = Dn.Offset(, 3)
                    [COLOR="Navy"]Next[/COLOR] R
                Dic(str) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] With
       [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] sht
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick