Combine data into one column

John.McLaughlin

Board Regular
Joined
Jul 19, 2011
Messages
155
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

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,192
Office Version
  1. 365
Platform
  1. Windows
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.
 

John.McLaughlin

Board Regular
Joined
Jul 19, 2011
Messages
155
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
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,192
Office Version
  1. 365
Platform
  1. Windows
Don't believe you copied entire ranges. Try again so that we see all the data.
 

John.McLaughlin

Board Regular
Joined
Jul 19, 2011
Messages
155

ADVERTISEMENT

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
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,192
Office Version
  1. 365
Platform
  1. Windows
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"
 

John.McLaughlin

Board Regular
Joined
Jul 19, 2011
Messages
155

ADVERTISEMENT

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
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,192
Office Version
  1. 365
Platform
  1. Windows
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.
 

John.McLaughlin

Board Regular
Joined
Jul 19, 2011
Messages
155
Thanks for the suggestions. I am self taught and I don't think learning PQ is the VBA answer I am looking for.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,573
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,186
Messages
5,640,687
Members
417,161
Latest member
Devon150

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
Top