• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 295
  • Last Modified:

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
0
ekaplan323
Asked:
ekaplan323
  • 6
  • 5
1 Solution
 
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
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

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

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now