Here it is...
Greetings,
Paul Willekens
'=======================================================================
Sub GetCenters()
Dim cLevel1
Dim cLevel2
Dim cLevel3
Dim cLevel4
Dim cLevel5
Dim cLevel6
Dim cRaw
Dim cTest
Dim lDone
Dim nCenter
Dim nRowIn
Dim nRowOut
nRowIn = 2
nRowOut = 5
cRaw = "Raw Data"
cTest = "test"
lDone = False
Sheets(cRaw).Activate
Application.ScreenUpdating = False
While Not lDone
nCenter = 0
If Len(Cells(nRowIn, 1).Value) > 0 Then
cLevel1 = Cells(nRowIn, 1).Value & " " & Cells(nRowIn, 2).Value
cLevel2 = ""
cLevel3 = ""
cLevel4 = ""
cLevel5 = ""
cLevel6 = ""
ElseIf Not IsEmpty(Cells(nRowIn, 2)) Then
If IsNumeric(Cells(nRowIn, 2).Value) Then 'center
nCenter = Cells(nRowIn, 2).Value
Else
cLevel2 = Cells(nRowIn, 2).Value & " " & Cells(nRowIn, 3).Value
cLevel3 = ""
cLevel4 = ""
cLevel5 = ""
cLevel6 = ""
End If
ElseIf Not IsEmpty(Cells(nRowIn, 3)) Then
If IsNumeric(Cells(nRowIn, 3).Value) Then 'center
nCenter = Cells(nRowIn, 3).Value
Else
cLevel3 = Cells(nRowIn, 3).Value & " " & Cells(nRowIn, 4).Value
cLevel4 = ""
cLevel5 = ""
cLevel6 = ""
End If
ElseIf Not IsEmpty(Cells(nRowIn, 4)) Then
If IsNumeric(Cells(nRowIn, 4).Value) Then 'center
nCenter = Cells(nRowIn, 4).Value
Else
cLevel4 = Cells(nRowIn, 4).Value & " " & Cells(nRowIn, 5).Value
cLevel5 = ""
cLevel6 = ""
End If
ElseIf Not IsEmpty(Cells(nRowIn, 5)) Then
If IsNumeric(Cells(nRowIn, 5).Value) Then 'center
nCenter = Cells(nRowIn, 5).Value
Else
cLevel5 = Cells(nRowIn, 5).Value & " " & Cells(nRowIn, 6).Value
cLevel6 = ""
End If
ElseIf Not IsEmpty(Cells(nRowIn, 6)) Then
If IsNumeric(Cells(nRowIn, 6).Value) Then 'center
nCenter = Cells(nRowIn, 6).Value
Else
cLevel6 = Cells(nRowIn, 6).Value & " " & Cells(nRowIn, 7).Value
End If
ElseIf IsNumeric(Cells(nRowIn, 7).Value) _
And Cells(nRowIn, 7).Value > 0 Then 'center
nCenter = Cells(nRowIn, 7).Value
Else
lDone = True
End If
If Not nCenter = 0 Then
Sheets(cTest).Activate
Cells(nRowOut, 1) = nCenter
Cells(nRowOut, 2) = cLevel6
Cells(nRowOut, 3) = cLevel5
Cells(nRowOut, 4) = cLevel4
Cells(nRowOut, 5) = cLevel3
Cells(nRowOut, 6) = cLevel2
Cells(nRowOut, 7) = cLevel1
nRowOut = nRowOut + 1
Sheets(cRaw).Activate
End If
nRowIn = nRowIn + 1
Wend
MsgBox "Done at row " & (nRowIn - 2)
End Sub
'=======================================================================
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our Facebook Group @ http://www.facebook.com/group.php?gid=287779555678
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,800 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
To unsubscribe, reply using "remove me" as the subject.
