Row data in columns

Closed
susant - Aug 15, 2009 at 02:26 PM
kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 - Aug 19, 2009 at 07:59 PM
Hello,

Dear Sir,
I have Data Like
324
Platinum
Gold
Silver
325
platinum
Silver
326
Gold
327
silver
328
329
platinum
330
Gold
I want the data as in column wise so that the Nos will be first column and then the texts are in rest columns.
as

324 Platinum Gold silver
325 Platinum 0 Silver
326 0 Gold 0
327 0 0 Silver
328 0 0 0
329 Platinum 0 0
330 0 Gold 0

Please help me .My Nos are integers and they have total 3 values in Row wise ,some have nil value and some have all 3 values ,some have single value.All Values are in Text format only Nos are 10 digits.

Regards,
Satyabrata Padhi

1 response

kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 12
Aug 19, 2009 at 07:59 PM
use this code.....

Sub CollectData()
'Collection based on "Nos" ,"Platinum","Gold" and "Silver" respectively
On Error GoTo CollectData_Error
Dim ws As Worksheet
Dim Num, i, j As Integer: Dim st, nd, rd As String
i = 1: j = 1: st = 0: nd = 0: rd = 0

'You can change your sheet name on below as your want. "sheet1" or "sheet2" etc
Set ws = ActiveWorkbook.Sheets("sheet1")

With ws
'Deleted old data
ws.Range("E:H").ClearContents
'Creat Header column
.Cells(j, 5) = "Number"
.Cells(j, 6) = "ST"
.Cells(j, 7) = "ND"
.Cells(j, 8) = "RD"
'Collection Data
Do Until .Cells(i, 1) = Null Or .Cells(i, 1) = ""
MyValue = Trim(.Cells(i, 1)) 'Trim is cut space in word
Select Case UCase(MyValue) 'Ucase for change value to upper charector
Case IsNumeric(Val(MyValue)) ' Check value is numberical or not
'For First record
If i = 1 Then
Num = .Cells(i, 1).Value
j = j + 1 'add row number for write the next row data
Else
'For record number 2 to n
'write data to column E to H
If j > 2 Then Num = .Cells(i, 1).Value
.Cells(j, 5) = Num
.Cells(j, 6) = st
.Cells(j, 7) = nd
.Cells(j, 8) = rd
'add row number for write the next row data
j = j + 1
'reset value
st = 0
nd = 0
rd = 0
End If
Case "PLATINUM"
st = "Platinum"
Case "GOLD"
nd = "Gold"
Case "SILVER"
rd = "Silver"
End Select
i = i + 1 ' Add row number to read the next row data
Loop

'For last record and write data to column E to H
If Not IsNumeric(MyValue) Then
.Cells(j, 5) = Num
.Cells(j, 6) = st
.Cells(j, 7) = nd
.Cells(j, 8) = rd
End If
End With


MsgBox "Finish" & "You have " & j - 2 & " record"
Exit Sub

CollectData_Error:
MsgBox Err.Description & " Number " & Err.Number
End Sub
0