Combining Multiple Columns into one column without any blank cells

mdesroc

New Member
Joined
Dec 8, 2012
Messages
18
I need to be able to combine 3 columns with ranges that may change into one column without any blank cells.

For example, I have columns B, C and D filled with data, but the number of cells in each of those columns will change based on user choices other places in the spreadsheet.

Is it possible to combine the data from B, C, D into Column A automatically and if so how would I go about doing that?

Thank you for any help or advice you can offer.
 
No, the macro that I posted

Code:
Sub test()
Dim LR As Long, i As Long
For i = 2 To 4
    LR = Cells(Rows.Count, i).End(xlUp).Row
    Range(Cells(1, i), Cells(LR, i)).Copy Destination:=Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next i
End Sub
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
For me it copied columns B, C and D - the results of my test

Excel Workbook
ABCD
1bcd
2bbcd
3bbcd
4bbd
5bbd
6bd
7cd
8cd
9cd
10dd
11d
12d
13d
14d
15d
16d
17d
18d
19d
Sheet1
 
Upvote 0
there arent any blanks in the original data. Is there anything special I have to do to run the macro? I just have been hitting the macro tab and clicking run
 
Upvote 0
Try this i am sure it will work
Code:
Sub Macro1()
rcB = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
rcC = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
rcD = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
    
    Range("B1", "B" & rcB).Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C1", "C" & rcC).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1", "D" & rcD).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        
        If ActiveSheet.Range("A" & r).Value = "" Then
            Range("A" & r).Delete Shift:=xlUp
            
        End If
  
     Next r
End Sub
 
Upvote 0
Hey VOG, Can you have a look at this code and give me some tips to shorten or make it more compact. I know this is not the cleanest of the code but i would appreciate if you can give me some useful tip as i only have working knowledge macros :)

Try this i am sure it will work
Code:
Sub Macro1()
rcB = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
rcC = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
rcD = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
    
    Range("B1", "B" & rcB).Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C1", "C" & rcC).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1", "D" & rcD).Copy
    Range("A" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        
        If ActiveSheet.Range("A" & r).Value = "" Then
            Range("A" & r).Delete Shift:=xlUp
            
        End If
  
     Next r
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,495
Messages
6,113,992
Members
448,538
Latest member
alex78

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