CODEWITHSUNDEEP
excelvba
manjeet singh
manjeet singh

Reputation: 87

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

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...

Data

Below result is expected from coding...

Result

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

Upvotes: 1

Views: 300

Answers (3)

norie
norie

Reputation: 9867

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

Upvotes: 1

SJR
SJR

Reputation: 23081

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

Upvotes: 2

Evil Blue Monkey
Evil Blue Monkey

Reputation: 2794

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

Upvotes: 0

Related Questions