Can someone help me insert a loop into this macro I created?

[Coyotex3]

I want to tell this code to continue until the end of the data.

Sub Macro11()

Selection.End(xlToRight).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Rent Expenses"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Cash Available"
ActiveCell.Offset(-1, 0).Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
Selection.End(xlDown).Select
Selection.End(xlToLeft).Select
End Sub

 

[My Aswer Is This]

Please explain in words what you trying to do.
All this selecting is not needed.

 

[Coyotex3]

Please explain in words what you trying to do.

We have no ideal what cell your selecting.

Trying to tell excel to always start on Column "E" and always go down to the end of the range to insert the wording I need and then jump into the next range.

 

[My Aswer Is This]

So in E1 enter what?
In E2 enter what?
Still need more details.

 

[Coyotex3]

So in E1 enter what?
In E2 enter what?
Still need more details.

It would have helped if I had inserted this as intended.

The spread sheet will be filled out with data like this I was able to get the macro to insert the "Rent Expenses" and "Cash Available" Change the color and cell size, jump down to the next range etc. Now I want to tell it to repeat the process.

 

[Tom Urtis]

Sub RangeLabels()
Application.ScreenUpdating = False
Dim area As Range, lngRentRow&
For Each area In Columns(1).SpecialCells(2).Areas
lngRentRow = area.Row + area.Rows.Count
With Cells(lngRentRow, 5)
.Value = "Rent Expenses"
.Interior.color = vbGreen
With .Offset(1)
.Value = "Cash Available"
.Interior.color = vbYellow
End With
End With
Next area
Columns(5).AutoFit
Application.ScreenUpdating = True
End Sub

 

[Coyotex3]

Sub RangeLabels()
Application.ScreenUpdating = False
Dim area As Range, lngRentRow&
For Each area In Columns(1).SpecialCells(2).Areas
lngRentRow = area.Row + area.Rows.Count
With Cells(lngRentRow, 5)
.Value = "Rent Expenses"
.Interior.color = vbGreen
With .Offset(1)
.Value = "Cash Available"
.Interior.color = vbYellow
End With
End With
Next area
Columns(5).AutoFit
Application.ScreenUpdating = True
End Sub

Tom thank you for this, this does what I need it to do. Is there a way of getting the specific macro(Used recorder for it) I posted to do it on a loop? Or is it impossible due to the way it was recorded?

 

[Alex Blakenburg]

Tom thank you for this, this does what I need it to do. Is there a way of getting the specific macro(Used recorder for it) I posted to do it on a loop? Or is it impossible due to the way it was recorded?

The following is not a solution. Tom's code is a solution.
But purely for demonstration purposes, the below is your code with the minium changes I could do to make it work in a loop.

Normally when using VBA you want to avoid using the Select or Activate method, and this features heavily in a recorded macro.
Acitivate and Select make the code hard to follow (you don't know where your are on the spreadsheet) and they really slow down the performance of the macro.

Sub Macro11()

    'Comment out next line which is dependant on the the cell selected at the time of running the macro
    'Since their are more headings past the required column D, it is too risky
    '    Selection.End(xlToRight).Select
    Range("E1").Select
    
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
    
    Do Until ActiveCell.Row > lastRow
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Rent Expenses"
        ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Cash Available"
        ActiveCell.Offset(-1, 0).Range("A1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        ActiveCell.Offset(1, 0).Range("A1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        Selection.End(xlDown).Select                ' Additional xlDown required after the first section
    Loop
  
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    
'    Remove these we want to reposition at the top
'       Selection.End(xlDown).Select
'       Selection.End(xlToLeft).Select
    Range("A1").Select                               ' Reposition cursor to A1
    
End Sub

 

[Coyotex3]

The following is not a solution. Tom's code is a solution.
But purely for demonstration purposes, the below is your code with the minium changes I could do to make it work in a loop.

Normally when using VBA you want to avoid using the Select or Activate method, and this features heavily in a recorded macro.
Acitivate and Select make the code hard to follow (you don't know where your are on the spreadsheet) and they really slow down the performance of the macro.

Sub Macro11()

    'Comment out next line which is dependant on the the cell selected at the time of running the macro
    'Since their are more headings past the required column D, it is too risky
    '    Selection.End(xlToRight).Select
    Range("E1").Select
   
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
   
    Do Until ActiveCell.Row > lastRow
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Rent Expenses"
        ActiveCell.Offset(1, 0).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Cash Available"
        ActiveCell.Offset(-1, 0).Range("A1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        ActiveCell.Offset(1, 0).Range("A1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
       
        Selection.End(xlDown).Select                ' Additional xlDown required after the first section
    Loop
 
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
   
'    Remove these we want to reposition at the top
'       Selection.End(xlDown).Select
'       Selection.End(xlToLeft).Select
    Range("A1").Select                               ' Reposition cursor to A1
   
End Sub

Thank you. I agree, Tom's code is the solution.

What you did helped me out a lot. I wanted to see the minimum amount of changes required to that code, to try and understand how the different wording affected the macro. Thank you!

 

[Alex Blakenburg]

No problem. Glad we could help & thanks for the feedback.