CODEWITHSUNDEEP
excelvba
Geoff De Ross
Geoff De Ross

Reputation: 39

Populate long table of 2 columns from several smaller tables

This seems like a simple solution that involves possibly a loop and a count, but i'm stumped as to how to write it. I have a worksheet that has several lists/tables that are side by side that i want to merge into 1 longer table that has all of the data in only 2 columns.

The source table goes on for more 'Rotations' than just the 3 in the screenshot, and the number of rows can vary and will likely have several hundred per 'Rotation'.

I put a screenshot of what I'm hoping the summary table will look like. The source data is on a worksheet called "Protocol Summary" and the destination worksheet for the 'compiled' list is on a worksheet called "Protocol Filter".

Source worksheet "Protocol Summary"

Destination worksheet "Protocol Filter"

It may seem a bit strange that the excel filters are in the 'Summary' worksheet and i'm trying to make a summary worksheet called 'filters' but i assure you, with the rest of the workbook, it does make some kind of sense.

Thanks in advance.

Upvotes: 1

Views: 38

Answers (1)

Wizhi
Wizhi

Reputation: 6549

Something like this would do the trick.

You have some tricky values in your example data, i.e.: 7E1. To keep the formatting of those numbers I added the line: 

Destination_sht.Cells(lrow_dest + 1, "A").NumberFormat = "@" 'To keep the text format if needed

Code:

Sub copy_values()

Dim lrow_src As Long
Dim lrow_dest As Long
Dim lcol_src As Long

Dim i As Long
Dim j As Long

Dim Source_sht As Worksheet
Set Source_sht = ActiveWorkbook.Worksheets("Protocol Summary") 'Set the name of the sheet to copy from
Dim Destination_sht As Worksheet
Set Destination_sht = ActiveWorkbook.Worksheets("Protocol Filter") 'Set the name of the sheet to paste to


lcol_src = Source_sht.Cells(5, Source_sht.Columns.Count).End(xlToLeft).Column 'Find the last column from the source sheet, looking at row 5


For i = 1 To lcol_src Step 2 'Loop from the first column to the last and consider only every second column (i.e. all columns with the name "EV TYPE")

lrow_src = Source_sht.Cells(Rows.Count, i).End(xlUp).Row 'Find last row in Source sheet for the current column

    For j = 7 To lrow_src 'Loop through each rotation, from row 7 to the last for each rotation
        lrow_dest = Destination_sht.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row in Sheet1
        Destination_sht.Cells(lrow_dest + 1, "A").NumberFormat = "@" 'To keep the text format if needed
        'Copy and paste part
        Destination_sht.Cells(lrow_dest + 1, "A").Value = Source_sht.Cells(j, i).Value 'Copy EV Type
        Destination_sht.Cells(lrow_dest + 1, "B").Value = Source_sht.Cells(j, i + 1).Value 'Copy COMP
    Next j

Next i
End Sub

Alternate version 1 of copy paste part:

Destination_sht.Cells(lrow_dest + 1, "A").Value = Source_sht.Cells(j, i).Value 'Copy EV Type
Destination_sht.Cells(lrow_dest + 1, "B").Value = Source_sht.Cells(j, i + 1).Value 'Copy COMP

Can be written in one line to, to speed things up:

Destination_sht.Range(Destination_sht.Cells(lrow_dest + 1, "A"), Destination_sht.Cells(lrow_dest + 1, "B")).Value = _
Source_sht.Range(Source_sht.Cells(j, i), Source_sht.Cells(j, i + 1)).Value

An alternative version 2 part to copy paste part for keeping format is to use (but it's much slower):

Source_sht.Range(Source_sht.Cells(j, i), Source_sht.Cells(j, i + 1)).Copy
Destination_sht.Range(Destination_sht.Cells(lrow_dest + 1, "A"), Destination_sht.Cells(lrow_dest + 1, "B")).PasteSpecial Paste:=xlPasteAll

Upvotes: 1

Related Questions