Create a Loop until the last cell

I created a mcro whcih I need to perform to reformat a report from another software.  I have included a sample with the macro.  
I would like to perform this macro from the active cell to the end of the table (a blank row.)

Thanks in advance
Reformat.xls
ekaplan323Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

TracyVBA DeveloperCommented:
Try this:

It will loop through all the rows from where the active cell is.  So if your activecell is B2, and the end of the data in column B goes to row 10, then it will loop through B2-B10
Sub myLoop()

    Dim i As Long
    Dim lastRow As Long
    
    lastRow = Range(ActiveCell.Address).End(xlDown).Row

    For i = ActiveCell.Row To lastRow
        Debug.Print i
    Next i

End Sub

Open in new window

0
nutschCommented:
try this update

Thomas

Sub Macro1()
'
' Macro1 Macro
'
Dim lastRow As Long, i As Long
Application.ScreenUpdating = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lastRow / 2 To 4 Step -1
    
    Cells(i * 2, 2).UnMerge
    Cells(i * 2, 1).Resize(1, 2).Cut Cells(i * 2 + 1, 1)
    Rows(i * 2).Delete
Next
Application.ScreenUpdating = True
End Sub

Open in new window

0
ekaplan323Author Commented:
nutsch,

Almost there,  When I used the whole file I am getting an error message The operaton ill cause some nerged cells to unmerge, do you want to continue?  I press yes and it comes up again and agian.  I have included a portion of the spreadshett with some more complete data

Eric
Reformat-3.xls
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

nutschCommented:
This version should be better

Thomas

Sub Macro1()
'
' Macro1 Macro
'
Dim lastRow As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
For i = lastRow To 4 Step -1
     
    If Len(Trim$(Cells(i, 1))) > 0 Then
        Cells(i, 2).UnMerge
        Cells(i, 1).Resize(1, 2).Cut Cells(i + 1, 1)
        Rows(i).Delete
    End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

0
ekaplan323Author Commented:
Thomas,

My bad, after the first set of data, there is a location in column A on that second line and it is stopping the macro.  I looked at you rmacro and I am not yet up to making the change myself, can you help again? I have attached another file with a little more data.

Eric
Reformat-3.xls
0
nutschCommented:
if you want the HQ crushed, use this update.

Thomas

Sub Macro1()
'
' Macro1 Macro
'
Dim lastRow As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
  
For i = lastRow To 4 Step -1
      
    If Len(Trim$(Cells(i, 1))) > 0 And IsNumeric(Cells(i, 1)) Then
        Cells(i, 2).UnMerge
        Cells(i, 1).Resize(1, 2).Cut Cells(i + 1, 1)
        Rows(i).Delete
    End If
Next
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ekaplan323Author Commented:
Thomas,

The HQ (Location) is the part I really need.  The first entries don't havea any location, that's OK, but I need to get all the data lined up on one line so I can sort by the location.

Eric
0
nutschCommented:
so do you move the columns to the right? move the location at the end of the line?
0
ekaplan323Author Commented:
Sure, as long as it is all on one line, it doesn't matter where it is.  That's fine.
0
nutschCommented:
OK
Sub Macro1()
'
' Macro1 Macro
'
Dim lastRow As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
  
For i = lastRow To 5 Step -1
      
    If Len(Trim$(Cells(i, 1))) > 0 And IsNumeric(Cells(i, 1)) Then
        Cells(i, 2).UnMerge
        Cells(i, 1).Resize(1, 2).Cut Cells(i + 1, 1)
        Rows(i).Delete
    Else
        Cells(i, 1).Cut Cells(i, 26)
    End If
Next
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

0
ekaplan323Author Commented:
Thomas,

I got an error message about the merged cells again and I added the line below after the Else and it worked.  Thanks for the help.  I learned something today!!

        Cells(i, 1).UnMerge
Sub Macro1()
'
' Macro1 Macro
'
Dim lastRow As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
   
For i = lastRow To 5 Step -1
       
    If Len(Trim$(Cells(i, 1))) > 0 And IsNumeric(Cells(i, 1)) Then
        Cells(i, 2).UnMerge
        Cells(i, 1).Resize(1, 2).Cut Cells(i + 1, 1)
        Rows(i).Delete
    Else
        Cells(i, 1).UnMerge
        Cells(i, 1).Cut Cells(i, 26)
    End If
Next
  
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

0
ekaplan323Author Commented:
After going through the code, I was able to understand what was going on.  
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.