Converting column data to rows urgent

exceluser9

Active Member
Joined
Jun 27, 2015
Messages
387
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
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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
 
Upvote 0
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
 
Upvote 0
Hi,

Thank you for updated code.

In sheet 1 data is getting pasted in from row 1, can it be pasted from row A2?
 
Upvote 0
Replace this line of code:
Code:
desWS.Rows("1:2").Delete
with this one:
Code:
desWS.Rows("1:1").Delete
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,908
Members
448,531
Latest member
mu88forum

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top