Convert data from columns to rows

thandanit · Mar 17, 2011

Hi everyone, I have a problem.
In want to convert data from columns to rows. But, I dont know do it. Please help me!!!
Ex:
Data:

Result:

Thanks

Weaver · Mar 17, 2011

This dumps the reformatted data to a new sheet, in this case called "DEST"

I've also assumed the source data is on a sheet called "source" but you should be able to change this

Code:

 Sub changeDateLayout()
    Dim i As Date
    Set src = Sheets("source")
    Set dst = Sheets("dest")
    With src
        .Range("A1").CurrentRegion.AutoFilter
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dt = .Range("A2", .Cells(lr, 1))
        For i = WorksheetFunction.Min(dt) To WorksheetFunction.Max(dt)
            If WorksheetFunction.CountIf(dt, i) > 0 Then
                With .Range("A1").CurrentRegion
                    .AutoFilter
                    .AutoFilter Field:=1, Criteria1:=i
                End With
                dt.Offset(, 1).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy
                With dst
                    lc = .Cells(2, Columns.Count).End(xlToLeft).Column
                    If lc > 1 Then lc = lc + 1
                    With .Cells(2, lc)
                        .PasteSpecial Paste:=xlValues
                        .PasteSpecial Paste:=xlFormats
                    End With
                    With .Cells(1, lc)
                        .Value = i
                        .Resize(, 5).HorizontalAlignment = xlCenterAcrossSelection
                    End With
                End With
            End If
        Next i
    End With
End Sub

thandanit · Mar 17, 2011

Weaver said:

This dumps the reformatted data to a new sheet, in this case called "DEST"

I've also assumed the source data is on a sheet called "source" but you should be able to change this

Code:

 Sub changeDateLayout()
    Dim i As Date
    Set src = Sheets("source")
    Set dst = Sheets("dest")
    With src
        .Range("A1").CurrentRegion.AutoFilter
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dt = .Range("A2", .Cells(lr, 1))
        For i = WorksheetFunction.Min(dt) To WorksheetFunction.Max(dt)
            If WorksheetFunction.CountIf(dt, i) > 0 Then
                With .Range("A1").CurrentRegion
                    .AutoFilter
                    .AutoFilter Field:=1, Criteria1:=i
                End With
                dt.Offset(, 1).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy
                With dst
                    lc = .Cells(2, Columns.Count).End(xlToLeft).Column
                    If lc > 1 Then lc = lc + 1
                    With .Cells(2, lc)
                        .PasteSpecial Paste:=xlValues
                        .PasteSpecial Paste:=xlFormats
                    End With
                    With .Cells(1, lc)
                        .Value = i
                        .Resize(, 5).HorizontalAlignment = xlCenterAcrossSelection
                    End With
                End With
            End If
        Next i
    End With
End Sub

Thanks for answer.
But I work in Microsoft Excel. Not Visual Baisic.
Can u say clearly for me???
Thank sir!!!

Weaver · Mar 17, 2011

check the links at the bottom of my post. This should take you to a page explaining some of the basics.

Unless you were actually looking for a non vb solution, which I think might be uber tricky, then you'll need to post this code into a module and run it as per the instructions.

However, what you will need to do is change the name of the tab with the data to "source" and create a new tab called "dest" for the reformatted data to appear on. you can change them back after.

You could change the names in these lines of code but I'm thinking you might be less confident about that

Code:

    Set src = Sheets("[B][I][U]source[/U][/I][/B]")
    Set dst = Sheets("[B][I][U]dest[/U][/I][/B]")

Weaver · Mar 17, 2011

Apologies, I noticed a slight oversight in the previously posted code, use this version instead, otherwise your headers don't get copied.

Code:

Sub changeDateLayout()
    Dim i As Date
    Set src = Sheets("source")
    Set dst = Sheets("dest")
    With src
        .Range("A1").CurrentRegion.AutoFilter
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dt = .Range("A1", .Cells(lr, 1))
        For i = WorksheetFunction.Min(dt) To WorksheetFunction.Max(dt)
            If WorksheetFunction.CountIf(dt, i) > 0 Then
                With .Range("A1").CurrentRegion
                    .AutoFilter
                    .AutoFilter Field:=1, Criteria1:=i
                End With
                dt.Offset(, 1).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy
                With dst
                    lc = .Cells(2, Columns.Count).End(xlToLeft).Column
                    If lc > 1 Then lc = lc + 1
                    With .Cells(2, lc)
                        .PasteSpecial Paste:=xlValues
                        .PasteSpecial Paste:=xlFormats
                    End With
                    With .Cells(1, lc)
                        .Value = i
                        .Resize(, 5).HorizontalAlignment = xlCenterAcrossSelection
                    End With
                End With
            End If
        Next i
    End With
End Sub

thandanit · Mar 18, 2011

Weaver said:

Apologies, I noticed a slight oversight in the previously posted code, use this version instead, otherwise your headers don't get copied.

Code:

Sub changeDateLayout()
    Dim i As Date
    Set src = Sheets("source")
    Set dst = Sheets("dest")
    With src
        .Range("A1").CurrentRegion.AutoFilter
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dt = .Range("A1", .Cells(lr, 1))
        For i = WorksheetFunction.Min(dt) To WorksheetFunction.Max(dt)
            If WorksheetFunction.CountIf(dt, i) > 0 Then
                With .Range("A1").CurrentRegion
                    .AutoFilter
                    .AutoFilter Field:=1, Criteria1:=i
                End With
                dt.Offset(, 1).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy
                With dst
                    lc = .Cells(2, Columns.Count).End(xlToLeft).Column
                    If lc > 1 Then lc = lc + 1
                    With .Cells(2, lc)
                        .PasteSpecial Paste:=xlValues
                        .PasteSpecial Paste:=xlFormats
                    End With
                    With .Cells(1, lc)
                        .Value = i
                        .Resize(, 5).HorizontalAlignment = xlCenterAcrossSelection
                    End With
                End With
            End If
        Next i
    End With
End Sub

DONE!!!
But, in Excel. Date format is d/m/yyyy, it works. But, dd/mm/yyyy, it didnt work.

Can u help me, Weaver???

Weaver · Mar 19, 2011

That's a bit annoying - I was kind of hoping the way I'd done it, it would work independently of regional settings. I'll have to have a think about this one, but I can't do it straight away as I'm currently nowhere near a copy of Excel.

I'm in the UK, so we use dd/mm/yyyy and it worked fine.

W

Weaver · Mar 20, 2011

thandanit said:
DONE!!!
But, in Excel. Date format is d/m/yyyy, it works. But, dd/mm/yyyy, it didnt work.
Can u help me, Weaver???

Not entirely sure if I know what you mean here. Your response implies (at least to me) that if the date format is d/m/yyyy then it works and if it's dd/mm/yyyy it doesn't.

Since I'm in the UK, I coded it on a version of Excel using dd/mm/yyyy, so obviously it works in this case. I also thought it would work in any other case , since your sample data showed the dates in m/d/yyyy format.

Do you think you could shed a little light on any possible misconceptions I might be having?

Convert data from columns to rows

thandanit

New Member

Excel Facts

Weaver

Well-known Member

thandanit

New Member

Weaver

Well-known Member

Weaver

Well-known Member

thandanit

New Member

Weaver

Well-known Member

Weaver

Well-known Member

Similar threads

Forum statistics

Share this page

Convert data from columns to rows

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock