Hi Vinu,

See the solution below... I created a sheet "test" to see the test
result... In the macro you can (after testing) modify statement
  cTest = "test"
to
  cTest = "Result Sheet"

Good luck.

Please feedback.

Kind 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
    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
      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
      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
      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
      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
    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.

Reply via email to