Repeated Column Data Transpose From Column to Rows.

Mariusbfn · Sep 5th 2022

Hi Guys

I a need to transpose a variable data set that is that is in 4 columns to 2 rows with a emty column between every column with data.

I think a macro would be the beter way forward rather than with a IF Statement. Unfortunately I am novice when it comes to coding

macros and would really appreciate any help.

Below is a sample of the data in one sheet

No, Aquifer 1 , Aquifer 2 , Aquifer 3

1 , Unconfined, Confined ,

2 , Unconfined, Confined , Uncertain

3 , Unconfined,

4 , Unconfined, Unconfined,

5 , Unconfined, Unconfined, Unconfined

It must be in the following format on another sheet:

No 1 , , 1 , , 2 , , 2 , , 2 , , 3 , ,

Unconfined, ,Confined, ,Unconfined, ,Confined, ,Uncertain, ,Unconfined, ,

I have also attached a xlsx file

Thank you in advance for any input.

Kind regards

Marius

Mumps · Sep 5th 2022

Try:

Code

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, LastRow As Long, r As Long, c As Long, col As Long: col = 2
    Set srcWS = Sheets("Input")
    Set desWS = Sheets("Output")
    desWS.Range("A1") = "No"
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 2 To LastRow
        cnt = WorksheetFunction.CountA(Rows(r)) - 1
        With desWS
            For c = 1 To cnt
                .Cells(1, col).Value = Cells(r, 1)
                .Cells(2, col).Value = Cells(r, c + 1)
                col = col + 2
            Next c
        End With
    Next r
    Application.ScreenUpdating = True
End Sub

Display More

Mariusbfn · Sep 6th 2022

Hi Mumps

Thank you very much for the reply and the code.

Unfortunately, the only output I get is “No” in Cell A1 of the “output” sheet.

Kind regards

Marius

Mumps · Sep 6th 2022

Try:

Code

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, LastRow As Long, r As Long, c As Long, col As Long: col = 2
    Set srcWS = Sheets("Input")
    Set desWS = Sheets("Output")
    desWS.Range("A1") = "No"
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 2 To LastRow
        cnt = WorksheetFunction.CountA(srcWS.Rows(r)) - 1
        With desWS
            For c = 1 To cnt
                .Cells(1, col).Value = srcWS.Cells(r, 1)
                .Cells(2, col).Value = srcWS.Cells(r, c + 1)
                col = col + 2
            Next c
        End With
    Next r
    Application.ScreenUpdating = True
End Sub

Display More

Mariusbfn · Sep 7th 2022

Good morning Mumps

Thank you very much. It works perfectly

Kind regards

Marius

Mumps · Sep 7th 2022

You are very welcome.

Repeated Column Data Transpose From Column to Rows.

Participate now!

Share

Similar Threads

How to run a formula on a cell I want to copy in VBA

Code overwriting data on paste problem

Transpose Data from Rows to Columns

Select Cells in a Row based on column header

Copy sections (columns) of Filtered Table data from active workbook and paste into another workbook

Need help sorting data from 2 columns in multiple rows.

Tags