Using dynamic range for autofill

user_19334186 0
Viewed 41

I would like to add a formula to a cell and then autofill all the way down to lr.

Currently I'm using:

lr = Cells.Find("*", Cells(1,1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Dim header as range
Set header = range("A1:AA1")

' The Group column has empty cells. It just has header as Group.
' This code finds the column header Group for me and puts formula in 1 cell under it. This part is fine.
header.Find("Group").Offset(1,0).FormulaR1C1 = "=left(rc[-1],4)"

' Now I need to autofill that formula all the way down to lr
' I'm currently using this
header.Find("Group").Offset(1,0).Autofill Range ("B2:B" & lr)

I do not want to use "B2:B" as Group column could be anywhere else. I'd like it to be more dynamic.

Is there a way to change "B2:B" so instead it finds Group header and autofills 1 cell down from it all the way down to lr?

autofill vba excel
1 Answers

Fill Below Header

Option Explicit

Sub FillBelowHeader()
    
    Const hRow As Long = 1
    Const Header As String = "Group"
    Const Formula As String = "=LEFT(RC[-1],4)"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    ' If the worksheet is filtered, the Find method will fail.
    If ws.FilterMode Then ws.ShowAllData
    
    Dim hrg As Range: Set hrg = ws.Rows(hRow)
    
    ' To find the index of the first occurrence of a string
    ' in a one-row or one-column range, you can use 'Application.Match'.
    ' It is case-insensitive.
    Dim hCol As Variant: hCol = Application.Match(Header, hrg, 0)
    If IsError(hCol) Then ' check if there was no match
        MsgBox "Header not found.", vbCritical
        Exit Sub
    End If
    
    Dim lRow As Long
    lRow = ws.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    If lRow = hRow Then ' check if no data below headers
        MsgBox "No data below headers.", vbCritical
        Exit Sub
    End If
    
    hrg.Cells(hCol).Resize(lRow - hRow).Offset(1).FormulaR1C1 = Formula
    ' e.g. hCol is 5 (column 'E') and lRow is 10:
    ' ws.Range("A1:XFD1").Cells(5).Address(0, 0) = "E1"
    ' ws.Range("E1").Resize(10 - 1).Address(0, 0) = "E1:E9"
    ' ws.Range("E1:E9").Offset(1).Address(0, 0) = "E2:E10"
    
End Sub
user_98140690
Related