简体   繁体   中英

Excel VBA: How do I add text to a blank cell in a specific column then loop to the next blank cell and add text?

I need a macro to add text to blank cells in Column A. The macro needs to skip cells that have text. The macro needs to stop looping at the end of the data set.

I am trying to use an If Else statement, but I think I'm on the wrong track. My current, non-working code is below. Thank you so much - I'm still new to VBA

Sub ElseIfi()

For i = 2 To 100

If Worksheets("RawPayrollDump").Cells(2, 1).Value = "" Then
Worksheets("RawPayrollDump").Cells(2, 1).Value = "Administration"

Else if(not(worksheets("RawPayrollDump").cells(2,1).value="")) then 'go to next cell

End If

Next

    
End Sub

To find the last row of data, use the End(xlUp) function.

Try this code. It replaces all empty cells in column A with Administration .

Sub ElseIfi()
    Set ws = Worksheets("RawPayrollDump")
    
    lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' last data row
        
    For i = 2 To lastrow  ' all rows until last data row
        If ws.Cells(i, 1).Value = "" Then  ' column A, check if blank
           ws.Cells(i, 1).Value = "Administration"  ' set text
        End If
    Next
End Sub

There is no need to loop. Please try this code.

Sub FillBlanks()

    Dim Rng         As Range
    
    With Worksheets("RawPayrollDump")
        Set Rng = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
    On Error Resume Next
    Set Rng = Rng.SpecialCells(xlCellTypeBlanks)
    If Err Then
        MsgBox "There are no blank cells" & vbCr & _
               "in the specified range.", _
               vbInformation, "Range " & Rng.Address(0, 0)
    Else
        Rng.Value = "Administration"
    End If
End Sub

Replace Blanks feat. CurrentRegion

Range.CurrentRegion

  • Since OP asked for "... stop looping at the end of the data set. " , I've written this CurrentRegion version.
  • As I understand it, the end of the data set doesn't mean that there cannot be blank cells below the last cell containing data in column A .
  • Use the 1st Sub to test the 2nd, the main Sub ( replaceBlanks ).
  • Adjust the const ants including the workbook (in the 1st Sub) to fit your needs.
  • Criteria is declared as Variant to allow other data types not just strings.

The Code

Option Explicit

Sub testReplaceBlanks()
    
    Const wsName As String = "RawPayrollDump"
    Const FirstCellAddress As String = "A2"
    Const Criteria As Variant = "Administration"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    replaceBlanks ws, FirstCellAddress, Criteria
    
End Sub

Sub replaceBlanks(Sheet As Worksheet, _
                  FirstCellAddress As String, _
                  Criteria As Variant)
    
' Define column range.
    
    Dim ColumnRange As Range
    Set ColumnRange = Intersect(Sheet.Range(FirstCellAddress).CurrentRegion, _
                                Sheet.Columns(Sheet.Range(FirstCellAddress) _
                                                   .Column))
    ' To remove the possibly included cells above the first cell:
    Set ColumnRange = Sheet.Range(Range(FirstCellAddress), _
                                  ColumnRange.Cells(ColumnRange.Cells.Count))
    ' Note that you can also use the addresses instead of the cell range
    ' objects in the previous line...
    'Set ColumnRange = sheet.Range(FirstCellAddress, _
                                  ColumnRange.Cells(ColumnRange.Cells.Count) _
                                             .Address)
    ' or a mixture of them.
    
' Write values from column range to array.
    
    Dim Data As Variant
    If ColumnRange.Cells.Count > 1 Then
        Data = ColumnRange.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
    End If

' Modify array.
    
    Dim i As Long, k As Long
    For i = 1 To UBound(Data)
        If IsEmpty(Data(i, 1)) Then Data(i, 1) = Criteria: k = k + 1
    Next i
    
' Write modified array to column range.
    
    ' The following line is used when only the first cell is known...
    'Sheet.Range(FirstCellAddress).Resize(UBound(Data)).Value = Data
    ' ...but since the range is known and is the same size as the array,
    ' the following will do:
    ColumnRange.Value = Data
    
' Inform user.
    
    If k > 0 Then GoSub Success Else GoSub Fail
    
    Exit Sub
    
' Subroutines

Success:
    MsgBox "Wrote '" & Criteria & "' to " & k & " previously " _
         & "empty cell(s) in range '" & ColumnRange.Address & "'.", _
           vbInformation, "Success"
    Return
Fail:
    MsgBox "No empty cells in range '" & ColumnRange.Address & "'.", _
           vbExclamation, "Nothing Written"
    Return
           
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM