Find first blank cell in a range and insert text

[HarperCash]

Hi,

I'm trying to create a macro that will check across a row to find the first blank and insert the text "Drop out".
The problem I'm having is it need to do this Starting from H2-S2 but also check down to the last cell in H and across each one. So it would check H2:S2, H3:S3, H4:S4 and on and on until the last row with data in column H. The amount of rows in H with data will change constantly.

I've only been able to figure out how to get it to check one row at a time. It also can't fill ALL blanks as rows just the very first one. Can anyone help me?

Range("H2").Select

Selection.End(xlToRight).Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Drop Out"

 

[Joe4]

Welcome to the Board!

Try this:

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim nc As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column H with data
    lr = Cells(Rows.Count, "H").End(xlUp).Row
    
'   Loop through all rows starting in row 2
    For r = 2 To lr
'       Find first blank in columns H to S
        If Cells(r, "H") = "" Then
            nc = 8
        Else
            If Cells(r, "I") = "" Then
                nc = 9
            Else
                nc = Cells(r, "H").End(xlToRight).Column + 1
            End If
        End If
'       Check to see if next blank falls before column S
        If nc <= 19 Then Cells(r, nc) = "Drop out."
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub

 

[HarperCash]

This is amazing!!! Thank you so much!

Welcome to the Board!

Try this:

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim nc As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column H with data
    lr = Cells(Rows.Count, "H").End(xlUp).Row
   
'   Loop through all rows starting in row 2
    For r = 2 To lr
'       Find first blank in columns H to S
        If Cells(r, "H") = "" Then
            nc = 8
        Else
            If Cells(r, "I") = "" Then
                nc = 9
            Else
                nc = Cells(r, "H").End(xlToRight).Column + 1
            End If
        End If
'       Check to see if next blank falls before column S
        If nc <= 19 Then Cells(r, nc) = "Drop out."
    Next r
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"
   
End Sub

This is amazing! Thank you so, so much!

 

[HarperCash]

Welcome to the Board!

Try this:

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim nc As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column H with data
    lr = Cells(Rows.Count, "H").End(xlUp).Row
   
'   Loop through all rows starting in row 2
    For r = 2 To lr
'       Find first blank in columns H to S
        If Cells(r, "H") = "" Then
            nc = 8
        Else
            If Cells(r, "I") = "" Then
                nc = 9
            Else
                nc = Cells(r, "H").End(xlToRight).Column + 1
            End If
        End If
'       Check to see if next blank falls before column S
        If nc <= 19 Then Cells(r, nc) = "Drop out."
    Next r
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"
   
End Sub

If I wanted to change the parameters from H2-S2 to F2-U2 which part of the macro would I amend?

 

[bebo021999]

Or:

Sub Insert()
Dim lr&, f
lr = Cells(Rows.Count, "H").End(xlUp).Row
Set f = Range("H2:S" & lr).Find("", Range("H2"), , , xlByRows)
If Not f Is Nothing Then Cells(f.Row, "H").Value = "Drop out."
End Sub

 

[Joe4]

If I wanted to change the parameters from H2-S2 to F2-U2 which part of the macro would I amend?

Just change the column references, i.e.

Sub MyMacro()

    Dim lr As Long
    Dim r As Long
    Dim nc As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column F with data
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    
'   Loop through all rows starting in row 2
    For r = 2 To lr
'       Find first blank in columns F to U
        If Cells(r, "F") = "" Then
            nc = 8
        Else
            If Cells(r, "G") = "" Then
                nc = 9
            Else
                nc = Cells(r, "F").End(xlToRight).Column + 1
            End If
        End If
'       Check to see if next blank falls before column U
        If nc <= 21 Then Cells(r, nc) = "Drop out."
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub