VBA to find values in several columns, based on common value in a different column, then copy paste to different sheet

mlepesant

New Member
Joined
Jun 16, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hello,

New to the forum. Good excel skills but almost no VBA experience.

I have a file that provides me with Bill of material for different products. Each product can have up to 7 or 8 level of BOM.
On the attached pictures are data (data tab) and the result I am looking for (desired result tab).
For a given product in column B, I want to find values in columns M, V, AE, AN, AW, BF, and BO, and paste those values in a list (along with the following 2 columns after M, V, AE, AN, etc) on a separate sheet, then remove duplicates in column C of the separate sheet.
The loop would then go through all products in the data tab in column B and do the same. I have up to 25k rows.
Thank you for your help.
 

Attachments

  • Desired result.JPG
    Desired result.JPG
    199.3 KB · Views: 17
  • Data.JPG
    Data.JPG
    157.2 KB · Views: 18

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

mlepesant

New Member
Joined
Jun 16, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
It is not clear what to do with this second and subsequent product. Does it get appended to the bottom of the first product data in the results sheets or does it replace? I have assumed appended at the bottom.
Correct. All subsequent products should then be appended to the previous ones.
It now seems to me that you want all the rows from Data moving to Results, but only those specific columns. If we then sort the data appropriately and remove duplicates (columns A & C on the Result sheet), would we have what you want?
Yes! That is exactly what I need
Could you also confirm (if the code below does not do what you want) whether those headings on the Data sheet are actually in row 2 or row 1. I am now assuming that they are actually in row 1 and you just moved them down so that you could show us with the green and yellow in row 1 of the image in post #1which columns toy wanted extracted.
Your assumption is correct. The headings in the data sheet are actually in row 1. I moved them down for the reason you are mentionning.
I am also assuming a 'Result' sheet exists and that it is empty or any data in it can be removed. Please advise details if this is not correct.
Again correct! The sheet exists. Does the code clean this sheet before it starts its routine?

I will be trying the code soon and get back to you with feedback.
Thank you very much for the time you are spending on this.
I could be way off the mark but this is what I am thinking.

VBA Code:
Sub Get_Data_v2()
  Dim aCols As Variant
  Dim lr As Long
 
  aCols = Split("2 3 13 14 15 22 23 24 31 32 33 40 41 42 49 50 51 58 59 60 67 68 69")  '<- Cols B, C, M, N, O, V, W, X, ..., BO, BP, BQ
  Application.ScreenUpdating = False
    lr = Sheets("Data").Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With Sheets("Result")
      .UsedRange.ClearContents
      .Range("A1").Resize(lr, UBound(aCols) + 1).Value = Application.Index(Sheets("Data").Cells, Evaluate("row(1:" & lr & ")"), aCols)
      With .UsedRange
        .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(3), Order2:=xlAscending, Header:=xlYes
        .RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
      End With
    End With
  Application.ScreenUpdating = True
End Sub
 

mlepesant

New Member
Joined
Jun 16, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Correct. All subsequent products should then be appended to the previous ones.

Yes! That is exactly what I need

Your assumption is correct. The headings in the data sheet are actually in row 1. I moved them down for the reason you are mentionning.

Again correct! The sheet exists. Does the code clean this sheet before it starts its routine?

I will be trying the code soon and get back to you with feedback.
Thank you very much for the time you are spending on this.
It is actually not far at all.

In the picture pasted, I highlight in yellow what the final result should look like (for space saving purpose I have grouped the columns I don't care about):

All item highlighted in yellow, belong to the product in column B.
Column V breaks down items that are in column M.
Column AE breaks down items that are in column V
Column AN breaks down items that are in column AE
Column AW breaks down items that are in column AN

So all highlighted items should then be listed in the Result sheet in the same column

Then the same process takes place for a different product in Column B, and all results should be appended to the previous ones.

1624030357128.png
 

mlepesant

New Member
Joined
Jun 16, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
It is not clear what to do with this second and subsequent product. Does it get appended to the bottom of the first product data in the results sheets or does it replace? I have assumed appended at the bottom.

It now seems to me that you want all the rows from Data moving to Results, but only those specific columns. If we then sort the data appropriately and remove duplicates (columns A & C on the Result sheet), would we have what you want?

Could you also confirm (if the code below does not do what you want) whether those headings on the Data sheet are actually in row 2 or row 1. I am now assuming that they are actually in row 1 and you just moved them down so that you could show us with the green and yellow in row 1 of the image in post #1which columns toy wanted extracted.

I am also assuming a 'Result' sheet exists and that it is empty or any data in it can be removed. Please advise details if this is not correct.

I could be way off the mark but this is what I am thinking.

VBA Code:
Sub Get_Data_v2()
  Dim aCols As Variant
  Dim lr As Long
 
  aCols = Split("2 3 13 14 15 22 23 24 31 32 33 40 41 42 49 50 51 58 59 60 67 68 69")  '<- Cols B, C, M, N, O, V, W, X, ..., BO, BP, BQ
  Application.ScreenUpdating = False
    lr = Sheets("Data").Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With Sheets("Result")
      .UsedRange.ClearContents
      .Range("A1").Resize(lr, UBound(aCols) + 1).Value = Application.Index(Sheets("Data").Cells, Evaluate("row(1:" & lr & ")"), aCols)
      With .UsedRange
        .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(3), Order2:=xlAscending, Header:=xlYes
        .RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
      End With
    End With
  Application.ScreenUpdating = True
End Sub
Peter_SSs . I think I replied to myself on post #23, but you should see it?
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

Why don't you just post your workbook to a file sharing site such DropBox with or without real information. This way we all can see what is going on.
 

mlepesant

New Member
Joined
Jun 16, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Why don't you just post your workbook to a file sharing site such DropBox with or without real information. This way we all can see what is going on.
Hi igold. Let me try to add one more picture, and then if that doesn't help I will move on to sharing the file if I figure out how :)

From the Data on post #23, the result should look like this. The yellow highlighted items below are each unique item from column M, V, AE, AN, AW, BF, for each products in column B.

1624033439774.png
 

Forum statistics

Threads
1,141,619
Messages
5,707,449
Members
421,509
Latest member
kt_mr_excel

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
Top