Fill blank cell value with non blank cell based another cell value - excel

Question

I have an issue with filling blank cells of a column.
I have 4 Column headings in A, B, C, D.
I am trying to create macro to fill blank cells for dynamic data as per attached Data able wherein cell value in Column D is randomly filled and blanked.. Blank cell value needs to filled based on value mentioned in Column A..
I have created the macro but it's working to fill the blank with above value only and not getting the exact result..
Can someone please help...
Below result is expected from coding...
Below is the macro which I have created
Sub FillblankCells()
lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
With Range("D2:D" & lr)
.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub

Answer 1

A dictionary is probably overkill, but this should work.
Sub x()
Dim lr As Long, r As Range
Dim oDic As Object
lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Set oDic = CreateObject("Scripting.Dictionary")
'store column A for each entry in D
For Each r In Range("D2:D" & lr).SpecialCells(xlCellTypeConstants)
oDic(r.Offset(, -3).Value) = r.Value
Next r
'retrieve each column A for blanks in D
For Each r In Range("D2:D" & lr).SpecialCells(xlCellTypeBlanks)
r.Value = oDic(r.Offset(, -3).Value)
Next r
End Sub

Answer 2

This appears to work, it's based on the values in column C.
Sub FillblankCells()
lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
With Range("D2:D" & lr)
.SpecialCells(xlBlanks).FormulaR1C1 = "=IF(R[-1]C[-1]<RC[-1], R[-1]C,R[1]C)"
.Value = .Value
End With
End Sub

Answer 3

You can sort the list before using your formula. Something like this might work:
Sub FillblankCells()
'Declarations.
Dim RngList As Range
Dim DblColumnQuote As Double
Dim DblColumnBuyerName As Double
'Setting.
Set RngList = Range("A1:D1")
DblColumnQuote = 1
DblColumnBuyerName = 4
'Resetting RngList.
Set RngList = Range(RngList, RngList.End(xlDown))
'Sorting RngList.
With RngList.Parent.Sort
.SortFields.Clear
.SortFields.Add Key:=RngList.Columns(DblColumnQuote), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.SortFields.Add Key:=RngList.Columns(DblColumnBuyerName), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange RngList
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With
'Filling the blank cells of the Buyer Name column in RngList.
With RngList.Columns(DblColumnBuyerName)
.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub