tourless
Board Regular
- Joined
- Feb 8, 2007
- Messages
- 144
- Office Version
- 365
- Platform
- Windows
Hi Folks.
I have a routine that is supposed to look for blank cells (after there is a subtotal placed on the data) and fill them with data. My problem is sometimes there is only one subtotal so that leaves the 'filling in the blanks' problem mute. My routine doesn't know how to handle that and ends up failing. Please be gentle with this code, it's one of my earliest routines and looking back I'm cringing at the selects and lack of loops and such... completely inefficient. I am going through the whole 1,582 lines and updating but feel free to hack away at this routine. -Thanks.
I have a routine that is supposed to look for blank cells (after there is a subtotal placed on the data) and fill them with data. My problem is sometimes there is only one subtotal so that leaves the 'filling in the blanks' problem mute. My routine doesn't know how to handle that and ends up failing. Please be gentle with this code, it's one of my earliest routines and looking back I'm cringing at the selects and lack of loops and such... completely inefficient. I am going through the whole 1,582 lines and updating but feel free to hack away at this routine. -Thanks.
VBA Code:
Sub FillBlanksA()
Dim rRange1 As Range, rRange2 As Range
Dim iReply As Integer
'I've selected my worksheet earlier in the macro so I do know where I am
'Check For Data
Range("A:A").Select
If Selection.Cells.Count = 1 Then
Exit Sub
ElseIf Selection.Columns.Count > 1 Then
Exit Sub
End If
'Set Error Handling for Blank Cells
Set rRange1 = Range(Selection.Cells(1, 1), Cells(65536, Selection.Column).End(xlUp))
On Error Resume Next
Set rRange2 = rRange1.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rRange2 Is Nothing Then
Exit Sub
End If
'Fill Blank Cells Column A
rRange2.FormulaR1C1 = "=R[-1]C"
rRange1 = rRange1.Value
Cells(Rows.Count, "A").End(xlUp).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
Call FillBlanksC
End Sub