Filldown Visible Cells in a Column - excel

Question

I need some help. I have two columns: A and B. Column A and Column B have the following headers "Status" and "State". A filter has been applied to select "down" from a choice of "up" and "down" in Column A. When Column A is filtered some blank cells are revealed in Column B after some cells in Column B is cleared. The amount of data in the sheet varies and the position of these blanks also vary. I will like to fill down these blank cells in Column B using the values in visible cells only (not from the values in the hidden cells). Can someone help me edit this code?
In the pic above SO will fill down from 50476 to 50492 without erasing the values in the hidden cells.
Sub Filldownvisiblecells ()
Dim ws as worksheet
Dim dl as long
Dim rg as range
ws = Workbooks("Book1.xlsm"). Worksheets("Sheet1")
dl = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'Filter Column A by Down
ws.Range("A1").AutoFilter Field:=1, Criteria1:="Down"
'Clearing States in Column B (This action generates blanks that I will like to filldown from visible cells NOT hidden cells)
ws.Range("B2:B" & dl).SpecialCells(xlCellTypeVisible).Select
For Each rg In Selection.Cells
If rg.Text = "R1" Or rg.Text = "R2" Or rg.Text = "UT" Then
rg.ClearContents
End If
Next rg
'Select Filldown Range in Column B
ws.Range("B2:B" & dl). SpecialCells(xlCellTypeVisible).Select
'Filldown Blanks in Column X
For Each rg In Selection.Cells
If rg.Value = "" Then
rg.FillDown
End If
Next rg
End Sub

Answer 1

Fill Down With Visible Cells' Values (AutoFilter)
Option Explicit
Sub FillDownVisible()
Const wsName As String = "Sheet1"
Const fRow As Long = 1 ' First Row
Const fCol As String = "A" ' Filter Column
Const fCriteria As String = "Down" ' Filter Criteria
Const dCol As String = "B" ' Destination Column
Dim ws As Worksheet
' The Workbook Containing This Code ('ThisWorkbook')
Set ws = ThisWorkbook.Worksheets(wsName)
' An Open Workbook
'Set ws = Workbooks("Book1.xlsm").Wordksheets(wsname)
' Possibly Closed Workbook (Needs the Full File Path)
'Set ws = Workbooks.Open("C:\Test\Book1.xlsm").Worksheets(wsName)
' Clear possible previous ('active') filter.
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
End If
' Create a reference to the Filter Range ('frg').
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, fCol).End(xlUp).Row
Dim frg As Range: Set frg = ws.Cells(fRow, fCol).Resize(lRow - fRow + 1)
' Create a reference to the Destination Data Range (no headers).
Dim ddrg As Range: Set ddrg = frg.EntireRow.Columns(dCol) _
.Resize(frg.Rows.Count - 1).Offset(1)
' Filter Filter Range.
frg.AutoFilter Field:=1, Criteria1:=fCriteria
' Create a reference to the Destination Range ('drg').
Dim drg As Range: Set drg = ddrg.SpecialCells(xlCellTypeVisible)
Dim dCell As Range ' Current Destination Cell
Dim pValue As Variant ' Previous Value
Dim cValue As Variant ' Current Value
' Loop through the cells of the Destination Range.
For Each dCell In drg.Cells
cValue = dCell.Value
Select Case UCase(CStr(cValue))
Case "R1", "R2", "UT", ""
dCell.Value = pValue
Case Else
pValue = cValue
End Select
Next dCell
ws.AutoFilterMode = False
End Sub