PDA

View Full Version : Stacking columns from several worksheets into a new worksheet



Gen22
07-22-2016, 09:03 AM
Hello. I'm currently working with 3 worksheets from a reporting utility and I only need a few columns from each report. The columns have to be combined into a master worksheet so that I can work with them from there. I've created dynamic ranges for each column or pairing of columns that I need because the workbook is connected to live data and the number of rows is subject to change. I'm looking for a VBA solution to "stack" the named ranges on top of each other in the new sheet without bringing the column heading along after the first sheet. The columns I need to work with have red titles.

Something like this:



ID

DeviceName
Status


(Sheet1 data)
(Sheet1 data)
(Sheet1 data)


(Sheet1 data)
(Sheet1 data)
(Sheet1 data)


(Sheet2 data)
(Sheet2 data)
(Sheet2 data)


(Sheet2 data)
(Sheet2 data)
(Sheet2 data)


(Sheet3 data)
(Sheet3 data)
(Sheet3 data)


(Sheet3 data)
(Sheet3 data)
(Sheet3 data)

p45cal
07-22-2016, 12:41 PM
Try this in your sample workbook:
Sub blah()
Set Destn = Sheets("CombinedData").Range("A1")
Destn.Parent.Cells.Clear
For Each sht In Sheets(Array("HardwareReport", "FNNS", "PlantDevices"))
If sht.Name = "HardwareReport" Then 'a different set of columns for this sheet.
Set RngToCopy = Intersect(sht.Range("A1").CurrentRegion, sht.Range("W1:X1,AD1,AL1,AN1:AP1,AR1:AS1,AU1").EntireColumn)
Else
Set RngToCopy = Intersect(sht.Range("A1").CurrentRegion, sht.Range("S1:T1,Y1,AF1,AH1:AJ1,AN1:AO1,AT1").EntireColumn)
Set RngToCopy = Intersect(RngToCopy, RngToCopy.Offset(1))
End If
RngToCopy.Copy Destn
Set Destn = Destn.Offset(RngToCopy.Rows.Count)
Next sht
End Sub


The headers are different from one sheet to the next and I've kept only the headers from the Hardware Report sheet, but I think that's what you wanted.

I've created dynamic ranges for each column or pairing of columns that I need… No dynamic named ranges in your attachment at all.




…because the workbook is connected to live data and the number of rows is subject to change.
You say the workbook is connected to live data - there are no connections to external data in your attachment. This may affect the macro's workings with your real data.

Gen22
07-25-2016, 07:07 AM
Hello p45cal and thanks for the response. I forgot to add the ranges when I created my sample workbook, this version has them now. I didn't include the data connections on purpose however. I used your code and it worked, so thank you for your help! My next question is: will this update to show the correct data if the number of rows changes? Also, can you please write comments in line so that I can try to gain an understanding of how the code works? I would like to learn more about VBA and having this example would help. Thank you again for your help, it's much appreciated.

p45cal
07-25-2016, 09:57 AM
It hinges around setting 2 ranges (Destn and RngToCopy) within a loop. Below, I've peppered the code with .Select statements so that as you step through the code with F8 on he keyboard you'll be able to see how those ranges are made up and how they change.
Sub blah()
Set Destn = Sheets("CombinedData").Range("A1")
Application.Goto Destn '(same as Destn.select)
Destn.Parent.Cells.Clear
For Each sht In Sheets(Array("HardwareReport", "FNNS", "PlantDevices"))
sht.Select
If sht.Name = "HardwareReport" Then 'a different set of columns for this sheet.
sht.Range("A1").CurrentRegion.Select
sht.Range("W1:X1,AD1,AL1,AN1:AP1,AR1:AS1,AU1").Select
sht.Range("W1:X1,AD1,AL1,AN1:AP1,AR1:AS1,AU1").EntireColumn.Select
Intersect(sht.Range("A1").CurrentRegion, sht.Range("W1:X1,AD1,AL1,AN1:AP1,AR1:AS1,AU1").EntireColumn).Select
Set RngToCopy = Intersect(sht.Range("A1").CurrentRegion, sht.Range("W1:X1,AD1,AL1,AN1:AP1,AR1:AS1,AU1").EntireColumn)
RngToCopy.Select
Else
sht.Range("A1").CurrentRegion.Select
sht.Range("S1:T1,Y1,AF1,AH1:AJ1,AN1:AO1,AT1").Select
sht.Range("S1:T1,Y1,AF1,AH1:AJ1,AN1:AO1,AT1").EntireColumn.Select
Intersect(sht.Range("A1").CurrentRegion, sht.Range("W1:X1,AD1,AL1,AN1:AP1,AR1:AS1,AU1").EntireColumn).Select
Set RngToCopy = Intersect(sht.Range("A1").CurrentRegion, sht.Range("S1:T1,Y1,AF1,AH1:AJ1,AN1:AO1,AT1").EntireColumn)
RngToCopy.Select
RngToCopy.Offset(1).Select
Set RngToCopy = Intersect(RngToCopy, RngToCopy.Offset(1))
RngToCopy.Select
End If
RngToCopy.Copy Destn 'this copies the data to the destination.
Set Destn = Destn.Offset(RngToCopy.Rows.Count) 'set for next time round the loop.
Destn.Select
Next sht
End Sub
I wouldn't bother with those named ranges - besides, if there are any empty cells amongst the data in those columns the ranges will be wrong.

Gen22
07-25-2016, 10:13 AM
Thanks for the edit, it clears up the algorithm!

snb
07-25-2016, 12:07 PM
All you need:


Sub M_snb()
For j = 1 To 3
sn = Sheets(Choose(j, "Hardwarereport", "FNNS", "Plantdevices")).Cells(1).CurrentRegion.Offset(Abs(j > 1))
Sheets("combineddata").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), 10) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), IIf(j = 1, Array(23, 24, 30, 38, 40, 41, 42, 44, 45, 47), Array(19, 20, 25, 32, 34, 35, 36, 40, 41, 46)))
Next
End Sub

p45cal
07-25-2016, 03:32 PM
All you need:Just be aware that the = Application.Index(sn, Evaluate("row… process converts dates to strings and depending on your locale the excel sheet might not convert them back into the correct dates.
Although unlikely ever to be missing, ensure that the bottom-most cell of the Asset ID columns of the first 2 sheets have data in them.