# VBA Macro to transpose 4 columns into two columns



## nutbolt (Dec 26, 2022)

Hi I've been looking at a lot of transpose demos, still can't get what I need to do this so let me explain. I have a four column table and I am looking to Transpose it over to a two column table or array?
It will reuse the column headers so I'm thinking a loop for them and a counter to increment, I'm confused if it can be done in Array or transpose. My image is below to help explain it. I'm looking for the table to become the two columns with data like that under it.


----------



## nutbolt (Dec 26, 2022)

coulbeit.xlsmABCD1EmailNumberNameStatus2bob@aol.com123bobby BallHome3fred@aol.com777Freddy StarrWork4jim@lie.net555Jim JimbobWork5sue@fre.com333Sue SuspectHomeData


----------



## nutbolt (Dec 27, 2022)

anyone?


----------



## Peter_SSs (Dec 27, 2022)

Is this what you want?


```
Sub Rearrange()
  Dim a As Variant, Hdr As Variant
  Dim i As Long, r As Long
  
  a = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value
  Hdr = Application.Transpose(Application.Index(a, 1, 0))
  r = Range("A" & Rows.Count).End(xlUp).Row - 2
  For i = 2 To UBound(a)
    r = r + 5
    Range("A" & r).Resize(4).Value = Hdr
    Range("B" & r).Resize(4).Value = Application.Transpose(Application.Index(a, i, 0))
  Next i
End Sub
```


----------



## Alex Blakenburg (Dec 27, 2022)

If you add this before the "Next i" in Peter's code it will restore the hyperlink for the email address.

```
Range("B" & r).Hyperlinks.Add Anchor:=Range("B" & r), Address:="mailto:" & Range("B" & r).Value
```


----------



## Peter_SSs (Dec 27, 2022)

Alex Blakenburg said:


> restore the hyperlink for the email address.


Good point.

Another way to retain those would be ..


```
Sub Rearrange_v2()
  Dim r As Range
  Dim i As Long
  
  Set r = Range("A1", Range("D" & Rows.Count).End(xlUp))
  For i = 2 To r.Rows.Count
    Union(r.Rows(1), r.Rows(i)).Copy
    Range("A" & Rows.Count).End(xlUp).Offset(2).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  Next i
  Application.CutCopyMode = False
End Sub
```


----------



## Alex Blakenburg (Dec 27, 2022)

Peter_SSs said:


> Good point.
> 
> Another way to retain those would be ..


That did a nice job of keeping a all the formatting as well as the hyperlinks.


----------



## nutbolt (Dec 28, 2022)

Peter_SSs said:


> Good point.
> 
> Another way to retain those would be ..
> 
> ...


works great thanks


----------



## Peter_SSs (Dec 28, 2022)

You're welcome. Thanks for the follow-up.


----------

