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
kaiyasit Posts 30 Registration date Sunday August 9, 2009 Status Member Last seen April 20, 2010 - Aug 19, 2009 at 07:59 PM
Related:
- Row data in columns
- Display two columns in data validation list but return only one - Guide
- Saints row 2 cheats - Guide
- Tmobile data check - Guide
- Gta 5 data download for pc - Download - Action and adventure
- How to delete a row in a table in word - Guide
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
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
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
