VBA - how to fill blanks with the same information in the same column but referencing to another column

[Mangosteenlu]

Hi All,
I am new to Forum & VBA, just wondering if anyone with good knowledge of VBA can help me with the issue i am facing at work.
We have the massive data downloaded from our system every week, which I need to manipulate the data into the right format. I extracted a few rows from our data set explaining what i need to do on a weekly basis.
In this example, i need to use filter on Column B to select one internal ref each time, then fill blanks in Column A same as the one shown in the same column, but they have to have the same internal ref. In this example, blank cells (A2 to A6) manually fill in as 'RE123' which is same as the cell from A7 to A9 as they have the same internal reference.
Can anyone write a VBA code to perform this task quickly? thank you so much for your help in advance.

 

[mumps]

Try:

Sub FillBlanksCells()
    Application.ScreenUpdating = False
    Dim srcRng As Range, v As Variant, i As Long, dic As Object, lRow As Long, fVisRow As Long, lVisRow As Long, fnd As Range
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("B2:B" & lRow)
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            Range("A1").CurrentRegion.AutoFilter 2, v(i, 1)
            Set srcRng = Range("A2:A" & lRow).SpecialCells(xlVisible)
            fVisRow = Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
            lVisRow = Cells(Rows.Count, "B").End(xlUp).Row
            Set fnd = srcRng.Find(what:="*", after:=Cells(fVisRow, 1), LookIn:=xlValues)
            srcRng = fnd
        End If
    Next i
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Mangosteenlu]

Hi Mumps,

Wow,you are brilliant, it works. Thanks very much for taking time to help me.
when i copy your VBA code to the real data, I have changed column A to N, and B to R, but it did not work. I think there must be something else needs be amended. Sorry, is it possible for you to help me once more time? I am really appreciate your help. thanks

 

[mumps]

Try:

Sub FillBlanksCells()
    Application.ScreenUpdating = False
    Dim srcRng As Range, v As Variant, i As Long, dic As Object, lRow As Long, fVisRow As Long, lVisRow As Long, fnd As Range
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("R2:R" & lRow)
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            Range("A1").CurrentRegion.AutoFilter 18, v(i, 1)
            Set srcRng = Range("N2:N" & lRow).SpecialCells(xlVisible)
            fVisRow = Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
            lVisRow = Cells(Rows.Count, "R").End(xlUp).Row
            Set fnd = srcRng.Find(what:="*", after:=Cells(fVisRow, 14), LookIn:=xlValues)
            srcRng = fnd
        End If
    Next i
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Mangosteenlu]

Hi Mumps,

you are a star, it works. thank you so much. This will save a lot of my time. thank you.

 

[mumps]

You are very welcome.