VBA loop to repeat code until blank cell is reached?

[vinvinvin123]

Hello!

I am recording a macro to process sheet. Here is the code:

Dim r As Integer

r = Range("U1").Value
i = Cells(2, r + 7).Select
Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT formula here....

Range("O2").Select
Selection.Copy
Range(Cells(2, r + 7), Cells(2, 19)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

I want this to repeat every 9 rows until the first blank cell - I understand that a loop can be used for this but how best to do it? Shall I repeat the whole code + 9 columns each time or just the copy past section at the end? I think both would work but I can't figure out how to do either.. any ideas?

Thanks in advance.

 

[JackDanIce]

Try:

Sub Macro1()


    Dim x   As Long
    Dim LR  As Long
    
    LR = Cells(Rows.Count, "U").End(xlUp).row
    
    Application.ScreenUpdating = False
    
    With Cells(2, Range("U1").Value + 7)
        .FormulaR1C1 = "=SUMPRODUCT FORMULA"
        .Copy
    End With
    
    For x = 2 To LR Step 9
        Cells(x, "U").PasteSpecial xlPasteFormulas
    Next x
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
    
End Sub

 

[vinvinvin123]

Hello,

Thanks for the reply.

Unfortunately this hasn't worked.. I am not sure where it has failed but it seems to have only succeeded to enter the formula into the first cell ( Cells(2, Range("U1").Value + 7) ).. this is the correct location for the starting point but it does not copy the formula to the remaining cells in the row and then it has not copied the formulas downwards? Any ideas?

If I can provide any further useful info please ask!

Thanks.

Thanks and best regards

 

[JackDanIce]

What column contains the row that has the last value on your sheet?

 

[vinvinvin123]

Data is stored in cells H:S - each cell is headed January - December.

Column U is blank apart from cell U1 which contained the formula "=MONTH(TODAY())"

This is used to calculate the first column in H:S that should have the SUMPRODUCT formula added as only the current month onwards should be updated, previous month's data should remain the same.

Does this help?

Thanks for your efforts so far!

 

[JackDanIce]

Try:

    Dim x   As Long
    Dim LR  As Long
    Dim rng As Range
    
    LR = Cells(Rows.Count, "H").End(xlUp).row
    
    Application.ScreenUpdating = False
    
    Set rng = Cells(2, Range("U1").Value + 7)
    rng.FormulaR1C1 = "=SUMPRODUCT FORMULA"
           
    For x = 2 To LR Step 9
        rng.Copy
        Cells(x, "U").PasteSpecial xlPasteFormulas
    Next x
    
    Set rng = Nothing
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
    
End Sub

 

[vinvinvin123]

Hello!

Thanks for replying again.
The formula you gave succeeded in copying the SUMPRODUCt formula every 9 rows in column U which was not quite what I was looking for.. I amended the formula as follows:

Sub FormatAvailabilitysheet()
'
' FormatAvailabilitysheet Macro
' Add formulas
'
    
'
    Workbooks.Open "Availability ( current ).xlsx"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "=MONTH(Today())"
    
   Dim x   As Long
    Dim LR  As Long
    Dim rng As Range
    Dim r As Integer
    r = Range("U1").Value
    LR = Cells(Rows.Count, "H").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    Set rng = Cells(2, Range("U1").Value + 7)
    rng.FormulaR1C1 = "=SUMPRODUCT..."
    For x = 2 To LR Step 9
        rng.Copy
        Range(Cells(x, r + 7), Cells(x, 19)).PasteSpecial xlPasteFormulas
    Next x
    
    Set rng = Nothing
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With

After changing the destination of the copy & paste to a range it covered all the months up to December from the current month, then the loop worked perfectly copying the formula every 9 rows.

Thanks so much for your help, I wouldn't have got anywhere near without your assistance!

Best regards,

Vin

 

[JackDanIce]

You;re welcome, glad it's resolved.