Stop excel macro from running if there is a blank cell in a column

[gomes123]

I have an excel macro that applies values in Columns O, P, Q, R. It works fine for Column O, but for Column P, Q & R, the values keep getting applied even though there is a blank cell/blank row. What I would like is for the cells highlighted in red (see attached image), that the excel macro doesnt apply the formulas in those cells. How would I fix this? Thanks

Sub ResetFormulaOnBlankRow()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim denominator As Double
    Dim FRow As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")            ' Change the sheet name as needed
    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row

    FRow = 3
    For i = 3 To lastRow
        If ws.Cells(i, 1).Value = "" Then
            denominator = ws.Cells(i, 4).Value
            FRow = i + 1
        Else
            ws.Cells(i, 15).Formula = "=" & "H" & i & "/" & "$D$" & FRow
            ws.Cells(i + 1, 16).Formula = "=" & "H" & i + 1 & "/" & "$D$" & FRow + 1
            ws.Cells(i + 2, 17).Formula = "=" & "H" & i + 2 & "/" & "$D$" & FRow + 2
            ws.Cells(i + 3, 18).Formula = "=" & "H" & i + 3 & "/" & "$D$" & FRow + 3

        End If
    Next i
End Sub

 

[RobP]

when it sees your blank rows in rows 7 and 22 (as you are checking if col A is "" or blank in your if statement), it is loading the denominator from col D and then increasing your count value by one.

So its your FRow = FRow + 1 which is your issue on those 2 blank rows, as you are effectively doing it twice)

(or maybe its your FRow + 1 and Frow + 2 in the bottom half of the if actually, as you are telling it to increase the row number everytime you paste an answer ?

Not sure what you are wanting it to look like really ? (maybe try and remove the +1, +2, +3 from the FRow counts in yrou ws.cells statements..

Rob

 

[RobP]

yep, sorry, its these I feel:

ws.Cells(i, 15).Formula = "=" & "H" & i & "/" & "$D$" & FRow
            ws.Cells(i + 1, 16).Formula = "=" & "H" & i + 1 & "/" & "$D$" & FRow + 1
            ws.Cells(i + 2, 17).Formula = "=" & "H" & i + 2 & "/" & "$D$" & FRow + 2
            ws.Cells(i + 3, 18).Formula = "=" & "H" & i + 3 & "/" & "$D$" & FRow + 3

as you are telling it to add a row number to each result. as I said above, try removing the +1, +2, +3 from the end of each line

 

[gomes123]

Thanks, I did try your suggestion but it is not working as I intended.

What I'm trying to do is basically to get these data into the cells
Cell O3 =H3/$D$3
Cell P4 =H4/$D$4
Cell Q5 =H5/$D$5
and so on, until a blank row is reached.
Then autofill the data downwards
until a blank row is reached.
Then it carries on after that blank row.
And to continue on, until another blank row is reached, until the end of the worksheet.
Cell O8 =H8/$D$8
Cell P9 =H9/$D$9
Cell Q10 =H10/$D$10

 

[RobP]

Sorry I didn't understand your first post, and what you are trying to do. So I understand now that you are deliberately dropping downwards as you go across.

Try this instead..

Sub ResetFormulaOnBlankRow()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i, x, y As Long
    Dim denominator As Double
    Dim rowadd, rowcheck, FRow As Long
    Dim blanks(), subrows As Variant 'arrays to store blank rows

    Set ws = ThisWorkbook.Sheets("Sheet1")            ' Change the sheet name as needed
    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row

    '*********** Find all blank rows in data, and store in array "blanks()" ************
    
    ReDim blanks(3 To lastRow) As Variant 'to replicate data rows incl. blanks rows
    x = 3 'first row of data
    y = 3 'first blanks() array location
    
    Do While x < lastRow
        If ws.Cells(x, 1).Value = "" Then
            blanks(y) = x 'if blank row, store row number in the array
            y = y + 1 'next array store location
        End If
        x = x + 1
    Loop

    '***********************************************************************************

    ' Now we have the blank rows in an array stored as "blanks(7,22)", we can use below code to check if a row is blank before
    ' we try to paste our formula code into the cells.  I wrap these around your formula storage routine below.
    
    'filter the array (check if blank row exists in there)
    'subrows = Filter(blanks, 5)  will check if row 5 exists in the array for example
    'if UBound value is greater than -1, then the row number is blank
    'If UBound(subrows) > -1 Then MsgBox ("I found blank")


    FRow = 3
    For i = 3 To lastRow
       
        If ws.Cells(i, 1).Value = "" Then
            denominator = ws.Cells(i, 4).Value
            FRow = i + 1
        Else
            ' check if the 4 formulas are going to be on a blank row. If so, stop at previous count
            For rowcheck = 0 To 3
                subrows = Filter(blanks, i + rowcheck)
                If UBound(subrows) <> -1 Then Exit For
            Next rowcheck
                
                   
            For rowadd = 0 To rowcheck - 1 ' Use previous count to load correct number of formulas (-1 as rowcheck gets inflated by 1 at end of Next loop)
                If i + rowadd <= lastRow Then  'check to ensure data stays within last row.
                    ws.Cells(i + rowadd, 15 + rowadd).Formula = "=" & "H" & i + rowadd & "/" & "$D$" & FRow + rowadd 'target row not blank
                End If
            Next rowadd

        End If
    Next i
End Sub

 

[RobP]

glad to have helped. thanks a lot for the feedback.

Rob