Results 1 to 6 of 6

Thread: Converting column data to rows urgent
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Jun 2015
    Posts
    362
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Converting column data to rows urgent

    Hi Team.

    I need a VBA code to transpose.column data into rows. Below is example.

    Sheet 2

    Column A Column B
    Sl no. Data
    17957 Missing number
    17957 Missing Data
    17957 Additional data required
    17957 Address not available
    17957 DOB Missing
    17957 Require account details

    In sheet when I input number 17957 it should give me all 6 row data in Column B, Column C, Column D, Column E, Column F, Column G

    Above is just an examples, there is no data limit, macro should run until the data is present and give results. No all sl no will have 6 row of data. It could be 1/2/3/4/5/6. Sl no will be keep on changing, it can be 2 digit or greater than that

    Sheet 1

    Column A
    17957

    Thanks

  2. #2
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,245
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Converting column data to rows urgent

    Try:
    Code:
    Sub Transpsoedata()
        Application.ScreenUpdating = False
        Dim Rng As Range, RngList As Object, key As Variant, desWS As Worksheet
        Set desWS = Sheets("Sheet1")
        Set RngList = CreateObject("Scripting.Dictionary")
        For Each Rng In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                RngList.Add Rng.Value, Nothing
            End If
        Next
        For Each key In RngList
            With Cells(1, 1).CurrentRegion
                .AutoFilter 1, key
                Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
                With desWS
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = key
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
                End With
            End With
        Next key
        Range("A1").AutoFilter
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  3. #3
    Board Regular
    Join Date
    Jun 2015
    Posts
    362
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Converting column data to rows urgent

    Hi

    It's working fine, could we add a blank row after each number in sheet 1?

  4. #4
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,245
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Converting column data to rows urgent

    Try:
    Code:
    Sub TransposeData()
        Application.ScreenUpdating = False
        Dim Rng As Range, RngList As Object, key As Variant, desWS As Worksheet
        Set desWS = Sheets("Sheet1")
        Set RngList = CreateObject("Scripting.Dictionary")
        For Each Rng In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                RngList.Add Rng.Value, Nothing
            End If
        Next
        For Each key In RngList
            With Cells(1, 1).CurrentRegion
                .AutoFilter 1, key
                Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
                With desWS
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0) = key
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(2, 0).PasteSpecial Transpose:=True
                End With
            End With
        Next key
        Range("A1").AutoFilter
        desWS.Rows("1:2").Delete
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  5. #5
    Board Regular
    Join Date
    Jun 2015
    Posts
    362
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Converting column data to rows urgent

    Hi,

    Thank you for updated code.

    In sheet 1 data is getting pasted in from row 1, can it be pasted from row A2?

  6. #6
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,245
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Converting column data to rows urgent

    Replace this line of code:
    Code:
    desWS.Rows("1:2").Delete
    with this one:
    Code:
    desWS.Rows("1:1").Delete
    Practice makes perfect. I'm very far from perfect so I'm still practising.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •