macro to fill blank cells with location

Hi,

I am trying to build a macro to fix a report so that location numbers will be beside all costs associated. It is likely best to display the data I have, and what I am looking to do.

Below I have provided an unedited report which is an example of what I am working with. Cell A1 will provide the location name (starting with 604 in example), and will have 1 to 7 rows of text in column B associated with that location, while column A will be blank until a there is a new location name. I would like to fill column A with location number beside each line of text (see edited report further below).

There is a blank row between each change in location name, then it will restart with a new location number and several rows of text.I do not need to keep the blank rows, but can anyone help with vba code to auto-fill column A with the location names?


UNEDITED REPORT
604 Text
(blank) Text
(blank) Text

605 Text

606 Text
(blank) Text


EDITED REPORT
604 Text
604 Text
604 Text

605 Text

606 Text
606 Text

Hi kellen

Try this

Option Explicit
Public Sub test()
    Dim LastRow As Long
    Dim Rng As Range
    Dim fCell As Range
    LastRow = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
                         SearchDirection:=xlPrevious).Row
    Set Rng = Range("A3:A" & LastRow)
    For Each fCell In Rng
        If Not fCell.Offset(0, 1) = "" And fCell = "" Then
            fCell.Value = fCell.Offset(-1, 0)
        End If
    Next fCell
End Sub

Hope this helps.

John

JB, that won't work correctly for a multi-area range.

Hi kellen
Glad it works for you. If you're satisfied, please mark your post as solved. Click the scales if you feel it appropriate.

John

Originally Posted by shg

JB, that won't work correctly for a multi-area range.

It won't? It seemed to work fine for my test which was 3 separate areas, as per the OP's example. Can you reference an example of what you mean? I used a formula in the macro that takes into account the fact the a row might be blank, it skips those...

I like this approach merely for the elimination of looping row by row, the formula does the evaluation for you all at once.

See attached.

Try this:

Sub AddLocations()

    With Columns("A:A").SpecialCells(xlCellTypeBlanks)
        .FormulaR1C1 = "=IF(RC[1]<>"""",R[-1]C,"""")"
        .Value = .Value
    End With

End Sub

SHG, how truly unexpected. The first line of code puts in the correct values for every row, but the second line of code somehow does NOT simply remove the formulas and leave the values behind, it seems to replicate the first formula result down the column!?

Any idea why?

Here's the corrected version for my approach, I guess I can't use the "WITH" method.

Sub AddLocations()
    Columns("A:A").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _
        "=IF(RC[1]<>"""",R[-1]C,"""")"
    Columns("A:A").Value = Columns("A:A").Value
End Sub

Because you get the value from the first area of the range applied to all.

You second aproach converts the entire column to values, which may or may not be fine.

Here's what I use:

Sub FillBlanksInSelection()
    FillBlanks ActiveWindow.RangeSelection
End Sub

Sub FillBlanks(r As Range)
    Dim rBlnk       As Range
    Dim rArea       As Range

    On Error Resume Next
    Set rBlnk = r.SpecialCells(xlCellTypeBlanks)
    If Err.Number Then
        MsgBox "No blanks found"
        Err.Clear
    Else
        On Error GoTo 0
        If Not Intersect(rBlnk, Rows(1)) Is Nothing Then
            MsgBox "Can't handle blanks in Row 1!"
        Else
            rBlnk.FormulaR1C1 = "=r[-1]c"
            For Each rArea In rBlnk.Areas
                rArea.Value = rArea.Value
            Next rArea
        End If
    End If
End Sub

It should have code to check if there are more than 16K cells in the range, which may break SpecialCells in an unpleasant way.