Loop to Fill Down to Next Specified Value and Repeat - excel

Question

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!

Answer 1

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

Answer 2

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