200+ Video Lessons
50+ Hours of Video
200+ Excel Guides
Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)
I have two columns of data
4 2
5 8
7 3
And I want to create one column where the values in the second column are below the corresponding values in the first column. So it would look like.
4
2
5
8
7
3
I can do this by copying and pasting via transpose but I want a macro because I have a lot of data.
Many thanks,
Jim
Paste the code below into a standard code module. None of the pre-existing code modules in a blank workbook fit that bill. You will have to add one, and its default name will be "Module1". You can change the name if you like.
Option Explicit
Enum Nwn ' worksheet navigation
NwnHeaderRowsCount = 1 ' important: adjust to reality on your sheet
Nwn1stColumn = 1 ' Columns: 1 = A
Nwn2ndColumn ' no value means preceding value + 1 (here = 2 = B)
NwnResultColumn
End Enum
Sub MergeColumns()
' 28 Aug 2017
Dim Arr As Variant ' working array
Dim Rng As Range ' target range
Dim Rl As Long ' last row in 1st column
Dim R As Long, i As Long ' row / index counters
With ActiveSheet ' to avoid accidents, better name the sheet
Rl = .Cells(.Rows.Count, Nwn1stColumn).End(xlUp).Row
Arr = .Range(.Cells(NwnHeaderRowsCount + 1, Nwn1stColumn), _
.Cells(((Rl - NwnHeaderRowsCount) * 2 + NwnHeaderRowsCount), Nwn2ndColumn)).Value
R = UBound(Arr)
For i = R / 2 To 2 Step -1
Arr(R - 1, 1) = Arr(i, 1)
Arr(R, 1) = Arr(i, 2)
R = R - 2
Next i
Arr(R, 1) = Arr(i, 2)
Application.ScreenUpdating = False
Set Rng = .Range(.Cells(NwnHeaderRowsCount + 1, NwnResultColumn), _
.Cells(UBound(Arr) + NwnHeaderRowsCount, NwnResultColumn))
Rng.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightOrBelow
Rng.Offset(0, -1).Resize(, UBound(Arr, 2)).Value = Arr
Rng.Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End With
End Sub
Treat the 'Enum' at the top of the code like a control panel. Specify how many header rows you have and specify 1st and 2nd columns of your numbers. Note that the macro expects them to be adjacent. You can specify a column for the result anywhere on your sheet. Its content will be over-written without warning.
If you want to follow my advice (in the remarks above) and specify the sheet on which you want the code to work, replace 'With ActiveSheet' with something like
With Worksheets("MySheet")