I have qualitative values in column A and quantitative values in column B associated with them.

I want to look for a specific value in column A, starting with A1. Once the value is found, I want to fill the value associated with it in column B down to the last row before the next value is found in column A. I want to repeat this until no more data is available in column A.

I have tried a number of formulas, but I think a VBA loop might be needed since I have nearly 25,000 rows.

Below is a visualization of what I am trying to do, looking for "W" and filling down. I greatly appreciate any thoughts or ideas!

CodePudding user response：

Fill Down Column With Matched Value

Option Explicit

Sub UpdateColumn()
    
    ' Define constants.
    Const FirstRowAddress As String = "A1:B1" ' at least two columns!
    Const sStringColumn As Long = 1
    Const dNumberColumn As Long = 2
    Const CriteriaString As String = "W"
     
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet 'improve!
    
    ' Declare variables referenced or calculated
    ' in the following With statement.
    Dim rg As Range
    Dim rCount As Long
    
    ' Reference the range ('rg') and write its number of rows
    ' to a variable ('rCount').
    With ws.Range(FirstRowAddress)
        Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count - .Row   1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If lCell Is Nothing Then
            MsgBox "No data in range.", vbCritical
            Exit Sub
        End If
        rCount = lCell.Row - .Row   1
        Set rg = .Resize(rCount)
    End With
    
    ' Write the values from the range to a 2D one-based array,
    ' the source array ('sData').
    Dim sData() As Variant: sData = rg.Value
    
    ' Define the 2D one-based one-column destination array ('dData').
    Dim dData() As Double: ReDim dData(1 To rCount, 1 To 1)
    
    ' Declare variables to be used in the following For...Next loop.
    Dim sString As String
    Dim dValue As Variant
    Dim dNumber As Double
    Dim r As Long
    
    ' Write the required values from the source array to the destination array.
    For r = 1 To rCount
        sString = CStr(sData(r, sStringColumn))
        If StrComp(sString, CriteriaString, vbTextCompare) = 0 Then ' is equal
            dValue = sData(r, dNumberColumn)
            If VarType(dValue) = vbDouble Then ' is a number
                dNumber = CDbl(dValue)
            Else ' is not a number
                dNumber = 0
            End If
        'Else ' is not equal; do nothing (use current number)
        End If
        dData(r, 1) = dNumber
    Next r
    
    ' Reference the destination range ('drg').
    Dim drg As Range: Set drg = rg.Columns(dNumberColumn)
    
    ' Overwrite the destination range values with the required values
    ' from the destination array.
    drg.Value = dData

    ' Inform.
    MsgBox "Column updated.", vbInformation

End Sub

CodePudding user response：

If I've understood what you need this could fit

Sub test()
    Dim LR As Long, Rng As Range, StartRow As Long, EndRow As Long, StartVal, c
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(1, 1), Cells(LR, 1))
    
    Set c = Columns(1).Find("W", after:=Cells(LR, 1), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            StartRow = c.Row
            StartVal = c.Offset(0, 1).Value
            Set c = Rng.FindNext(c)
            EndRow = IIf(c.Row > StartRow, c.Row, LR)
            Range(Cells(StartRow   1, 2), Cells(EndRow - 1, 2)) = StartVal
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End Sub