Concatenating columns of differing widths - VBA: MIcrosoft, Excel, 2003, VBA

by: jeffldPosted on 2008-02-07 at 15:08:30ID: 20846334

Can you repost the code as a code snippet? It looks like something is missing.

by: FUROGPosted on 2008-02-07 at 15:57:24ID: 20846681

Attached as a snippet. In the original text I had a few extra DIMs

Do While ActiveCell <> ""  'Loops until the active cell is blank.
 
        ActiveCell.Offset(0, 0).FormulaR1C1 = _
           ActiveCell.Offset(0, 0) & "," & ActiveCell.Offset(0, 1)
           ActiveCell.Offset.Range(0
        ActiveCell.Offset(1, 0).Select
Loop
End Sub

1:
2:
3:
4:
5:
6:
7:
8:

Select all Open in new window

by: jeffldPosted on 2008-02-07 at 16:13:58ID: 20846778

That code isn't valid, but I get the general idea.

It looks like what you are looking for is something that will concatenate and pad in blanks where needed.

basically, what needs to happen is each field needs to be inspected to find the largest string length for each column, then when appending the fields together, pad the necessary blanks onto the end of each field so that all the fields line up nicely.

Unfortunately It will be painfully slow if you are processing more than a few dozen rows and columns because every field will need to be inspected for string length, then compared to an array to see if the cell contains a string that is larger current largest string for that column.

maybe another expert can help by actually providing a function that does this, or possibly suggest a more efficient means to accomplish what you want.

by: FUROGPosted on 2008-02-07 at 16:25:09ID: 20846814

I am actually putting a comma between each field. I ran this small snippet in Excel as a test with 2 columns and it was fast. I am trying to figure out how to use an input variable to control the # of offsets that take place.

For instance I want to concatenate 10 columns so I want to offset 10 times and add the comma.

I can manually write them out but was looking for help on a loop function across the row that could satisfy this and add the comma.

Thanks for...for uh...yeah, I can wait until the next expert. Smiles

by: RobSampsonPosted on 2008-02-07 at 17:04:45ID: 20846984

Hi, try this macro:

Sub ConcatColumns()

Dim count As Integer
Dim ccol As Integer
Dim crow As Integer

start1 = InputBox("Enter the column letter to start concatenation from (inclusive):", "Start Column")
end1 = InputBox("Enter the column letter to end concatenation at (inclusive):", "End Column")

'MsgBox Asc(start1) - 64

' Insert a blank column at the end for concatenation
Columns(Chr(Asc(end1) + 1) & ":" & Chr(Asc(end1) + 1)).Insert Shift:=xlToRight

For crow = 2 To Cells(65536, start1).End(xlUp).Row
For ccol = (Asc(start1) - 64) To (Asc(end1) - 64)
If ccol = (Asc(start1) - 64) Then
Cells(crow, Asc(end1) - 63).FormulaR1C1 = _
Cells(crow, ccol).FormulaR1C1
Else
Cells(crow, Asc(end1) - 63).FormulaR1C1 = _
Cells(crow, Asc(end1) - 63).FormulaR1C1 & _
"," & Cells(crow, ccol).FormulaR1C1
End If
Next
Next
End Sub

Regards,

Rob.

by: jeveristPosted on 2008-02-07 at 20:00:01ID: 20847716

Hi FUROG,

Here's one way to do it but the attached code snippet uses arrays for processsing and is much faster with a large number of rows (15x faster with 900 rows). Try them both and let me know if they work for you.

Sub ConcatColumns()
Dim val As Variant, cel As Range, icount As Long, icols As Long, irows As Long

icols = 0

Do While icols = 0
val = InputBox("Enter the # of columns to concatenate. Make sure you are in the 1st cell in the first row and column you want to concatenate.", "Concatenation Thingy")
If val = "" Then
MsgBox "Process canceled. Exiting routine."
Exit Sub
End If

On Error Resume Next
icols = CLng(val)
On Error GoTo 0

If icols = 0 Then
MsgBox "Please enter the number of columns."
End If
Loop

Application.ScreenUpdating = False

Set cel = ActiveCell

For irows = cel.Row To Cells(Rows.count, cel.Column).End(xlUp).Row
For icount = 1 To icols - 1
If cel.Offset(0, icount) <> "" Then
cel = cel & "," & cel.Offset(0, icount)
End If
Next icount
Set cel = cel.Offset(1)
Next irows

Application.ScreenUpdating = True

End Sub

Jim

Sub ConcatColumnsNew()
Dim val As Variant, cel As Range, icount As Long, icols As Long, irows As Long, arr1 As Variant, arr2 As Variant
Dim i As Long, j As Long
    
icols = 0
    
Do While icols = 0
    val = InputBox("Enter the # of columns to concatenate. Make sure you are in the 1st cell in the first row and column you want to concatenate.", "Concatenation Thingy")
    If val = "" Then
        MsgBox "Process canceled.  Exiting routine."
        Exit Sub
    End If
    
    On Error Resume Next
    icols = CLng(val)
    On Error GoTo 0 
    If icols = 0 Then
        MsgBox "Please enter the number of columns."
    End If
Loop
    
Application.ScreenUpdating = False
    
Set cel = ActiveCell
irows = Cells(Rows.count, cel.Column).End(xlUp).Row - cel.Row + 1
    
arr1 = cel.Resize(irows, icols)
arr2 = cel.Resize(irows, 1)
    
For i = 1 To irows
    For j = 2 To icols
        If arr1(i, j) <> "" Then
            arr2(i, 1) = arr2(i, 1) & "," & arr1(i, j)
        End If
    Next j
Next i
    
cel.Resize(irows, 1) = arr2
    
Application.ScreenUpdating = True
    
End Sub

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:

Select all Open in new window

by: FUROGPosted on 2008-02-08 at 11:22:31ID: 31429046

The arrays worked well. My row depth was 100 and column depth was 33 so it was hard to tell between both solutions as they both worked well. Thanks for the awesome response...you guys rock!

Question

Concatenating columns of differing widths - VBA

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

MIcrosoft

Excel

2003

VBA

Microsoft Excel Spreadsheet Software

Miscellaneous Programming

VB Script

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Need individual assistance?

Our experts are ready to help.

Want to learn from the best?

Read articles from industry experts.

Working on a long term project?

Store your work and research.

What Makes Experts Exchange Unique?

Trusted by the world's most respected brands.

Faithfully serving IT professionals since 1996.

Related Solutions

Free Tech Articles

Cloud Class Webinars

Join the Community

Give a Little. Get a Lot.

Answers

3 Ways to Join

The Experts

The Experts

Testimonials

Testimonials

Testimonials

Business Clients

Business Clients

In the Press

In the Press

In the Press