Skip to main content
added 296 characters in body
Source Link
Raystafarian
  • 21.8k
  • 12
  • 62
  • 90

We're gonna learn you some VBA this morning and you're going to feel good about that! Put on your rocket boots and get ready to sail!

This macro will do it for you if it's all in column A

Hit Alt + F11 to bring up VBA editor. Right click insert - module. Paste the code below in the module and to go debug - compile project and hit F5 to run it. Easy breezy.

Sub transposedelete()

Dim rownum As Long
Dim colnum As Long
Dim data, result
colnum = 1

Application.ScreenUpdating = False

'check if the data on the sheet start where the code expects it
If Range("a1") = "" Then Exit Sub


    ' define data range
    With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)
    data = .Value
    numrows = UBound(data)
    
    'loop it
    For rownum = 2 To numrows
    
    Range((Cells(rownum, colnum)), (Cells(rownum + 1, colnum))).Copy
    ' transpose
    Cells(rownum - 1, colnum + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    'delete rows (this could be cleaner)
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    
    
    Next
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Easy as 1, 2, 3:


enter image description here
2.
enter image description here
3.
enter image description here

See now that wasn't difficult *or* intimidating, was it? And now you have a trick up your sleeve! Learning is great fun!

This macro will do it for you if it's all in column A

Hit Alt + F11 to bring up VBA editor. Right click insert - module. Paste the code below in the module and to go debug - compile project and hit F5 to run it. Easy breezy.

Sub transposedelete()

Dim rownum As Long
Dim colnum As Long
Dim data, result
colnum = 1

Application.ScreenUpdating = False

'check if the data on the sheet start where the code expects it
If Range("a1") = "" Then Exit Sub


    ' define data range
    With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)
    data = .Value
    numrows = UBound(data)
    
    'loop it
    For rownum = 2 To numrows
    
    Range((Cells(rownum, colnum)), (Cells(rownum + 1, colnum))).Copy
    ' transpose
    Cells(rownum - 1, colnum + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    'delete rows (this could be cleaner)
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    
    
    Next
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub

We're gonna learn you some VBA this morning and you're going to feel good about that! Put on your rocket boots and get ready to sail!

This macro will do it for you if it's all in column A

Hit Alt + F11 to bring up VBA editor. Right click insert - module. Paste the code below in the module and to go debug - compile project and hit F5 to run it. Easy breezy.

Sub transposedelete()

Dim rownum As Long
Dim colnum As Long
Dim data, result
colnum = 1

Application.ScreenUpdating = False

'check if the data on the sheet start where the code expects it
If Range("a1") = "" Then Exit Sub


    ' define data range
    With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)
    data = .Value
    numrows = UBound(data)
    
    'loop it
    For rownum = 2 To numrows
    
    Range((Cells(rownum, colnum)), (Cells(rownum + 1, colnum))).Copy
    ' transpose
    Cells(rownum - 1, colnum + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    'delete rows (this could be cleaner)
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    
    
    Next
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Easy as 1, 2, 3:


enter image description here
2.
enter image description here
3.
enter image description here

See now that wasn't difficult *or* intimidating, was it? And now you have a trick up your sleeve! Learning is great fun!

Source Link
Raystafarian
  • 21.8k
  • 12
  • 62
  • 90

This macro will do it for you if it's all in column A

Hit Alt + F11 to bring up VBA editor. Right click insert - module. Paste the code below in the module and to go debug - compile project and hit F5 to run it. Easy breezy.

Sub transposedelete()

Dim rownum As Long
Dim colnum As Long
Dim data, result
colnum = 1

Application.ScreenUpdating = False

'check if the data on the sheet start where the code expects it
If Range("a1") = "" Then Exit Sub


    ' define data range
    With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)
    data = .Value
    numrows = UBound(data)
    
    'loop it
    For rownum = 2 To numrows
    
    Range((Cells(rownum, colnum)), (Cells(rownum + 1, colnum))).Copy
    ' transpose
    Cells(rownum - 1, colnum + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    'delete rows (this could be cleaner)
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Rows(rownum).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    
    
    Next
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub