Sorting contents from columns to RowsClosed

Question

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.

TrowaD · Answer

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

Sorting contents from columns to Rows

1 response

Similar discussions

Subscribe To Our Newsletter!