Fill Blanks Failure

[tourless]

Hi Folks.

I have a bunch of sheets and depending on the data they may contain one or more items that are subtotaled. If there are multiple items the code below works fine but sometimes there is only one item and it fails. How can I account for instances where there is only one item? What happens is rRange2 gets set to nothing and skips 'Fill Blank Cells Column A.

Sub FillBlanksA_MTD()

    Dim rRange1 As Range, rRange2 As Range
    Dim iReply As Integer

    '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
    On Error GoTo 0
    If rRange2 Is Nothing Then
        FillBlanksC_MTD
    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)
        
    FillBlanksC_MTD

End Sub

 

[DanteAmor]

I don't understand what problem you have when there is only one item, because I don't know which cell you are selecting, but the following may help you.

With the following you can know how many rows are in the range:

rRange2.Rows.Count

For example:

Sub FillBlanksA_MTD()
 
    Dim rRange1 As Range, rRange2 As Range
    Dim iReply As Integer
    Dim n As Long

    'Set Error Handling for Blank Cells
    Set rRange1 = Range(Selection.Cells(1, 1), Cells(65536, Selection.Column).End(xlUp))
    rRange1.Select
    On Error Resume Next
    Set rRange2 = rRange1
    n = rRange2.Rows.Count
    If n = 1 Then
      'what do you want to do if it's one?
    Else
      '
    End If
    On Error GoTo 0
   
    If rRange2 Is Nothing Then
        FillBlanksC_MTD
    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)
       
    FillBlanksC_MTD

End Sub

 

[tourless]

What I'm trying to accomplish overall is once my data is subtotaled (at each change in column B, Sum columns D through I), I then need to fill columns A and C for the blank cells in columns A and C. I'm try to make this...

123	Item	.8
123	Item	.8
	Item Total
	Grand Total

into this...

123	Item	.8
123	Item	.8
123	Total Item	.8
123	Grand Total	.8

but in the case of more than one item I need this...

123	Item 1	.8
123	Item 1	.8
	Total Item 1
234	Item 2	.5
234	Item 2	.5
234	Item 2	.5
	Total Item 2
	Grand Total

turned in into this...

123	Item 1	.8
123	Item 1	.8
123	Total Item 1	.8
234	Item 2	.5
234	Item 2	.5
234	Total Item 2	.5
234	Grand Total	.5

It amounts to filling the blank cells in those columns with the value one cell above until the end of the data is reached.

 

[DanteAmor]

I then need to fill columns A and C for the blank cells in columns A and C.

According to your previous post, the column that contains the last row with data is column B.
Based on column B we are going to fill in the spaces in columns A and C.
Try this:

Sub FillBlanksA_MTD()
  On Error Resume Next
  With Range("A1:C" & Range("B" & Rows.Count).End(3).Row)
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
  End With
End Sub

 

[tourless]

Sub FillBlanksA_MTD() On Error Resume Next With Range("A1:C" & Range("B" & Rows.Count).End(3).Row) .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Value = .Value End With End Sub

Well ain't that something... That's a heck of a lot easier than then convoluted way I was trying to go about it.