Merging 2 Columns (different length) from Multiple Worksheets into a Summary Worksheet + pulling data

[ExcelStarter8888]

Hi Everyone,

Really really need help here especially as i am a VBA beginner. I'm trying to run a macro to consolidate 2 different columns with different length from all the worksheets in the workbook (there can be 10 or 5 or 2 worksheets, it's not fixed) into a summary worksheet.

Ie. Column A in all the worksheets is "ID" and Column B is "Date" and have different lengths. Thus the summary worksheet will have the consolidated "ID" and "Date" in Column A and Column B respectively.


Once the above is done,
For Column A, I am trying to combine every 2 rows, (A2 with A3, A4 with A5, A6 with A7......) to another Column, (ie. Column C)
For Column B, I am trying to pull all the dates to another column (ie. Column D) as this column can contain other information

My apology for any confusion and any help is greatly appreciated.

 

[AFPathfinder]

Looks like you'll need some loops. The first loop would be for looping through all the worksheets:

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    'Code to execute on each sheet goes here
Next ws

The next bit is to identify the bottom of the column you are copying and adding to. This can be put in a variable or referenced directly. If the last row in column A is the same as column B on the same sheet, this is easier:

finalRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:B" & finalRow).Copy Destination:=Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

The next part is a little confusing, but you can loop through the summary sheet and combine every two values (IDs or Dates?)

Dim i As Integer
Dim finalRow As integer

finalRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To finalRow Step 2
    Cells(i, 3).Value = Cells(i, 1).Value + Cells(i + 1, 1).Value
Next i

Making column D sounds like you can just copy column B and paste in column D, right? Or do you need to do some string parsing? That might change the preceding loop to do both tasks in the same loop.

 

[ExcelStarter8888]

Hi AFPathfinder,

First let me say thank you so much for the help!

Points as per below:
1. Unfortunately the last row in column A is lower than the last row in column B
2. For Column D, it needs to look through column B and pull all the dates sequentially. (To further explain Column B can contain names, dates, other items)

Thank you so much once again.

This is great help for my journey into VBA.

 

[ExcelStarter8888]

Range("A2:B" & finalRow).Copy Destination:=Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

also Gives me an error "Copy method of Range class failed"

 

[AFPathfinder]

I know for me, I was and still am loving VBA and what you can do with it. It's intimidating and it's hard to find others that are willing to dive into it.

As for the column A/B lengths, it just means you'll need to copy over each column separately. I think the ".Row" of the Copy line is what is causing the problem (my fault). If you strip off the ".Row" and change the "+ 1" to Offset from the Destination, it should work.

[COLOR=#333333]Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
[/COLOR][COLOR=#333333]Range("B2:B" & [/COLOR][COLOR=#333333]Cells(Rows.Count, 2).End(xlUp).Row[/COLOR][COLOR=#333333]).Copy Destination:=Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1)[/COLOR]

The column D solution could be done a couple different ways. If the dates are the only values in column B that can be read as a number, you would just need to check for values greater than 1 while looping through each row. Combining that task with the column C task would be more efficient, but you'd need to add an If statement to check which row it's on for combining every other row.

For i = 2 To finalRow
    If Cells(i, 1).Row Mod 2 = 0 Then
        Cells(Rows.Count, 3).End(xlUp).Offset(1)[COLOR=#333333] = Cells(i, 1).Value + Cells(i + 1, 1).Value[/COLOR]
    End If
    If Cells(i, 2).Value > 1 Then
        Cells(Rows.Count, 4).End(xlUp).Offset(1) = Cells(i, 2).Value
    End If
Next i