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
CurrentRegion
version.A
.replaceBlanks
).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.