Find first blank cell in a range and insert text

HarperCash

New Member
Joined
Jul 7, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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"
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Welcome to the Board!

Try this:
VBA Code:
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
 
Upvote 0
Solution
This is amazing!!! Thank you so much!
Welcome to the Board!

Try this:
VBA Code:
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!
 
Upvote 0
Welcome to the Board!

Try this:
VBA Code:
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?
 
Upvote 0
Or:
VBA Code:
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
 
Upvote 0
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.
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top