Combine data into one column

John.McLaughlin

Board Regular
Joined
Jul 19, 2011
Messages
169
Hello,

I sell goods and services, and keep a table by part no of each item needed to complete the order – “the packing list”. It works great if there is only one item sold.

When there are multiple items on the order, I need to combine the table into a single column.

Here is the full code. It keeps pasting the columns instead of finding the last empty row in Column A

Thanks in advance!



Code:
Sub PostPackingList()


' PackingListPost - post from OPEN ORDER PackingList SS to Scheduled PackingList SS
'
'
   ' Copy items to sheet.
   '
   '
   Application.ScreenUpdating = False
  
   Dim wbTarget            As Workbook 'workbook where the data is to be pasted SCHEDULED:PackingList
   Dim wbThis              As Workbook 'workbook from where the data is to copied Open Order"PackingList
   Dim strName             As String   'name of the source sheet/ target workbook
   Dim filelink            As String   ' name of workbook
   Dim targetFile As String
  
' ----------------- Find last row
    Dim DstRng As Range
    Dim DstWks As Worksheet
    Dim LastRow As Long
    Dim N As Long, r As Long
    Dim SrcRng As Range
    Dim SrcWks As Worksheet
' ------------------ End find last row

   'set to the current active workbook (the source book is the Open Order)
   Set wbThis = ActiveWorkbook

      'get the active sheetname of the Open Order workbook
   strName = ActiveSheet.Name
   

    ' Activate the Scheduled Workbook and select the PackingList worksheet
    Workbooks("SCHEDULED.xlsm").Activate
    Set wbTarget = ActiveWorkbook
    Sheets("PackingList").Select

 
   'activate the Open Order source book
   wbThis.Activate
   
     
  ' copy the range from source book
    wbThis.Sheets("PackingList").Range("A5:Z5").Copy
    

' Assign the Worksheets
        Set SrcWks = wbThis.Sheets("PackingList")
        Set DstWks = wbTarget.Sheets("PackingList")
       
' Get all cells in the Source Range starting with row 5
        Set SrcRng = SrcWks.Range("A5:Z5")
        LastRow = SrcWks.Cells(Rows.Count, "B").End(xlUp).Row
        If LastRow < SrcRng.Row Then Exit Sub Else Set SrcRng = SrcRng.Resize(LastRow - SrcRng.Row + 1, 26)
       
       
' Find the next empty row in the Destination Range starting at row 3
       
        Set DstRng = DstWks.Range("A3:A3")
        LastRow = DstWks.Cells(Rows.Count, "A").End(xlUp).Row
        Set DstRng = IIf(LastRow < DstRng.Row, DstRng, DstRng.Offset(LastRow - DstRng.Row + 1, 0))
       
          ' Copy the Source cells to the next empty Destination row if the Source Cell in "A" is not empty
         
            For r = 1 To SrcRng.Rows.Count
                If SrcRng.Cells(r, "A") <> "" Then
                    DstRng.Offset(N, 0).Resize(, 5).Value = SrcRng.Rows(r).Value
                  
                   N = N + 1
                End If
            Next r
       
   'save the target book
   wbTarget.Save

   'activate the source book again
   wbThis.Activate
   Sheets("ORDER").Select
   


Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A1").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
       
Set wbTarget = Nothing
Set wbThis = Nothing


End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
How about showing us some sample data as there may be more than one way to solve your issue. Use XL2BB to present a sample before and after scenario.
 
Upvote 0
How about showing us some sample data as there may be more than one way to solve your issue. Use XL2BB to present a sample before and after scenario.

Book1
A
1PART 1
Sheet1


Book1
A
24
Sheet2


Its 5 columns, Part 1, Part 2, etc in each column. Wanting to consolidate all of the columns into Column A
 
Upvote 0
Don't believe you copied entire ranges. Try again so that we see all the data.
 
Upvote 0
Don't believe you copied entire ranges. Try again so that we see all the data.
BEFORE
Book1
ABCDE
1PART 1PART 6PART 11PART 16PART 21
2PART 2PART 7PART 12PART 17PART 22
3PART 3PART 8PART 13PART 18PART 23
4PART 4PART 9PART 14PART 19PART 24
5PART 5PART 10PART 15PART 20PART 25
Sheet1


AFTER
Book1
A
1PART 1
2PART 2
3PART 3
4PART 4
5PART 5
6PART 6
7PART 7
8PART 8
9PART 9
10PART 10
11PART 11
12PART 12
13PART 13
14PART 14
15PART 15
16PART 16
17PART 17
18PART 18
19PART 19
20PART 20
21PART 21
22PART 22
23PART 23
24PART 24
25PART 25
Sheet2
 
Upvote 0
Able to accomplish with Power Query. Load to PQ editor. Unpivot all columns. Delete headers in Column A. Split column. Sort Number Column. Merge columns.

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}, {"Column3", type text}, {"Column4", type text}, {"Column5", type text}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Removed Columns", "Value", Splitter.SplitTextByDelimiter(" ", QuoteStyle.Csv), {"Value.1", "Value.2"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Value.1", type text}, {"Value.2", Int64.Type}}),
    #"Sorted Rows" = Table.Sort(#"Changed Type1",{{"Value.2", Order.Ascending}}),
    #"Merged Columns" = Table.CombineColumns(Table.TransformColumnTypes(#"Sorted Rows", {{"Value.2", type text}}, "en-US"),{"Value.1", "Value.2"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Merged")
in
    #"Merged Columns"
 
Upvote 0
I don't quite follow. Sorry, I am not familiar with Power Query, I am trying to create a macro to run. Is that VBA code I can add to the macro? Thanks in advance
 
Upvote 0
It is not VBA code. It is Mcode. Here is some information on PQ and Mcode if you are at all interested.

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.
 
Upvote 0
Does the BEFORE table always have the same number of rows in every column like that sample appears to have?

BTW, you don't have the latest version of XL2BB so you may want to update to get the latest features and bug fixes.
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,309
Members
448,564
Latest member
ED38

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
Back
Top