VBA copy/paste data based off of column headers

[ninjazor]

Hi everybody

Long story short, I work for a construction company and I am in the process of making things much more efficient.
I have built a small database in Access and have a connection pulling all that data into my workbook.
Currently my database has 70 columns and will be expanded to around 200 when its done. With easily 2000 rows when done aswell.
I have built a basic selector with some parameters to pick something out of the database.
I have then got that selection pulling all the info for that particular item from the database using xlookup.

Now I want to create a macro that grabs(copy) info from this and pastes it to 1 of 4 sheets dependant on the data. I would like to be able to have it copy and paste the data to corresponding column headers. For example width to width. drawer box size to drawer box size. Obviously I have to point it to the correct sheet but I can't find any code that simplifies just copying data from one column to its matching column on another page.

Any help would be great. Hope I explained this well enough as I am not a VBA expert.
Here's some pics to hopefully make things easier to understand.


https://imgur.com/a/qBCyUwz
https://imgur.com/a/LoLu4bV

 

[ninjazor]

Ok screen grabs

Database - https://imgur.com/a/dlsVD4x

Build - https://imgur.com/a/a30xMqW
Has an activex combo box to pick a specific cabinet

Math - https://imgur.com/a/FZhMhTy
Takes the cabinet picked and pulls all the info from the database sheet by using xlookup. You can see the formula in the bar

Cut List Boxes - https://imgur.com/a/iWTUdjY
This is 1 of 4 destination sheets for the copied data. Get 1 to work first, then the other 3 after.

Macro 1 - https://imgur.com/a/vBendx2
This one copies data to only the top row. Doesnt check to see if it is full of data, just copies right over it

Macro 2 - https://imgur.com/a/k7qpTDd
This one worked but now doesn't. I don't know why.

Macro 3 - https://imgur.com/Z7eb7xR
Doesn't copy data but does remove zeros and leaves empty cells if data is already present.

Build page fully filled out how I would like it to look when its ready to print - https://imgur.com/4NmQSgD

The only thing I have changed in the macros was Database to Math for source sheet. And Macro 1 I tried to clean things up a little bit so I can read it better

 

[DanteAmor]

Did you read my post #20 ?, You just need 2 screens.

 

[ninjazor]

Did you read/look at my post?
I figured I would just give you everything I was doing. Try and make things clearer.
Its literally all the examples I can give. I honestly do not know how to make things clearer.
I can only give you as much as I have.
lets try and take you through the process

The build sheet takes data from 1 specific column on the database sheet(the "code" column) and inserts that to the math sheet in the "code" column.
The math sheet then pulls all relevant data from the database for the specific "code" picked. The macro then copies all the corresponding data to the cut list - boxes sheet.
The macro is triggered by clicking the build command button on the build sheet.
Then you would pick a different cabinet in the combo box on the build sheet and everything would be repeated but copying on the next available row on the cut list sheet.
The final screen I put would have what a completed cut list would look like. Like final, ready to print.

I have been comparing macro 1 and macro 2/3. Trying to see what you changed and whats the same. I created a test worksheet and have been running a test of where I am moving line by line from Macro 2/3 to Macro 1. As Macro 1 is the only one that copies any data.

 

[DanteAmor]

Sorry, I misunderstood the requirement from the beginning.


Forget all macros.


Let us begin.


I will try to explain what you require.


1. You select a code in a combobox (ex. B18R).


2. The macro should go to the "Database" sheet, look for the code B18R in the code column (column A).


3. If the macro finds the code, copy that record in the "Cut List - Boxes" sheet, but only the columns that match. And paste it in row 2.


4. You select a code in a combobox (ex. B30).


5. The macro, search, copy and now paste in row 3.


That is what you need?

 

[ninjazor]

YES!!! Exactly

And don't apologize. I am sorry for being such a noob

 

[DanteAmor]

Output for one sheet
Change "sheet" name for your sheet with combobox.
Chantge "ComboBox1" for the name of your combo.

Sub copy_paste_data_based_column_headers_1()
  Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, lc As Long, lr As Long, wRow As Long
  Dim vl As Variant, f As Range, c As Range
 
  Set sh = Sheets("Sheet")              'sheet with combobox
  Set sh1 = Sheets("Database")          'origin
  Set sh2 = Sheets("Cut List - Boxes")  'destination
 
  vl = Sheets(sh.Name).ComboBox1.Value
  If vl = "" Or Sheets(sh.Name).ComboBox1.ListIndex = -1 Then
    MsgBox "Select value"
    Exit Sub
  End If
 
  Set f = sh1.Range("A:A").Find(vl, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "Code does not exists"
  Else
    'Compare header and 'copy value
    For i = 1 To sh1.Cells(1, Columns.Count).End(xlToLeft).Column
      Set c = sh2.Rows(1).Find(sh1.Cells(1, i), , xlValues, xlWhole)
      If Not c Is Nothing Then
        If i = 1 Then lr = sh2.Cells(Rows.Count, c.Column).End(xlUp).Row + 1
        sh2.Cells(lr, c.Column).Value = sh1.Cells(f.Row, i).Value
      End If
    Next
  End If
  MsgBox "End"
End Sub

Multi-sheet output

Sub copy_paste_data_based_column_headers_2()
  Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, lc As Long, lr As Long, wRow As Long, j As Long
  Dim vl As Variant, f As Range, c As Range, arr As Variant
 
  Set sh = Sheets("Sheet")              'sheet with combobox
  Set sh1 = Sheets("Database")          'origin
  arr = Array("Cut List - Boxes", "Sheet2", "Sheet3", "Sheet4") 'here your sheets
 
  vl = Sheets(sh.Name).ComboBox1.Value
  If vl = "" Or Sheets(sh.Name).ComboBox1.ListIndex = -1 Then
    MsgBox "Select value"
    Exit Sub
  End If
  Set f = sh1.Range("A:A").Find(vl, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "Code does not exists"
    Exit Sub
  End If
  For j = 0 To UBound(arr)
    Set sh2 = Sheets(arr(j))  'destination
    'Compare header and 'copy value
    For i = 1 To sh1.Cells(1, Columns.Count).End(xlToLeft).Column
      Set c = sh2.Rows(1).Find(sh1.Cells(1, i), , xlValues, xlWhole)
      If Not c Is Nothing Then
        If i = 1 Then lr = sh2.Cells(Rows.Count, c.Column).End(xlUp).Row + 1
        sh2.Cells(lr, c.Column).Value = sh1.Cells(f.Row, i).Value
      End If
    Next
  Next
  MsgBox "End"
End Sub

 

[ninjazor]

Thanks for all the hard work on the weekend no less. I have been busy in the shop yesterday so just getting back to this today.
I just tried both of them. They run but nothing gets copied. I am not sure if its the combo box or what. There is no output but it does run fine. I get the msg box. I do not get a "select value" msg box tho.

Edit - sh.Name - should I be changing Name to the name of the sheet that its on?
Edit2 - Nope that doesn't work. Breaks the macro

 

[DanteAmor]

What type of combo do you have userform or ActiveX?

If you want I adapt the macro to your file.

You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[ninjazor]

Its an an ActiveX

I don't know if I can becasue the database sheet pulls info from an access database. Let me see if I can upload them

Edit - Should I make it a normal one? Not ActiveX?
Edit2 - Nope. Normal one looks terrible

 

[DanteAmor]

I attach my test file, so you can review it and try to adapt the macro to your sheets.

Dropbox - File Deleted - Simplify your life

www.dropbox.com