Sorting contents from columns to Rows

Closed
ganeshkrish85
Posts
1
Registration date
Tuesday October 21, 2014
Status
Member
Last seen
October 21, 2014
- Oct 21, 2014 at 09:56 AM
TrowaD
Posts
2880
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 2, 2022
- Oct 21, 2014 at 11:05 AM
Hi,

I have data sets in particular file format.

Total no: of rows : 3623 (Column A)
Total no: of rate cards: 26 (Column E)
Rates for each code name in particular rate card (Column F)

Codename DisplayText ID Type RateName Rates
17OHP 17 OH Progesterone 4720 INV RPP 260
5HIAA 5-Hydroxy-indole Acetic Acid 4425 INV RPP 360
17OHP 17 OH Progesterone 4720 INV UMSC 0
5HIAA 5-Hydroxy-indole Acetic Acid 4425 INV UMSC 0
17OHP 17 OH Progesterone 4720 INV Dr Price 130
5HIAA 5-Hydroxy-indole Acetic Acid 4425 INV Dr Price 180
17OHP 17 OH Progesterone 4720 INV Alpha SC 168
5HIAA 5-Hydroxy-indole Acetic Acid 4425 INV Alpha SC 232
17OHP 17 OH Progesterone 4720 INV Lab Referral 149
5HIAA 5-Hydroxy-indole Acetic Acid 4425 INV Lab Referral 206

I need to sort this into following format


Code Name RPP UMSC Dr Price Alpha SC Lab Referral
17OHP 260 0 130 168 149
5HIAA 360 0 180 232 206



Thanks in Advance.

1 reply

TrowaD
Posts
2880
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 2, 2022
510
Oct 21, 2014 at 11:05 AM
Hi Ganeshkrish,

Source sheet is named Sheet1.
Destination sheet is named Sheet2.

Sheet2 should contain header as well as the unique codenames.
Using your sample data, Sheet2 looks like:
Code Name RPP UMSC Dr Price Alpha SC Lab Referral
17OHP
5HIAA


When you have met the above criteria, then try the code below:
Sub RunMe()
Dim lRow As Integer

Sheets("Sheet1").Select
lRow = Range("A1").End(xlDown).Row
x = 2

Do
    For Each cell In Range("A2:A" & lRow)
        If cell = Sheets("Sheet2").Cells(x, "A") Then
            Sheets("Sheet2").Cells(x, Columns.Count).End(xlToLeft).Offset(0, 1) = cell.Offset(0, 5)
        End If
    Next cell
    
    x = x + 1
Loop Until IsEmpty(Sheets("Sheet2").Cells(x, "A"))

End Sub


Best regards,
Trowa
0