Excel VBA add value to entire column that matches a specific header

user_10352704 0
Viewed 42

So i need to add 2021 to the Assessment year column in my worksheet but the range keeps breaking

LastRow is returning the correct value but i cant manage to figure out why range isnt working

   Sub AutoFill()

   Dim rFind As Range
   Dim ColumnLetter As Variant
   Dim ColumnNumber As Variant
   Dim LastRow As Variant
   Dim Fill As Range

   With Range("A1:P1")
   Set rFind = .Find(What:="AssessmentYear", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 
   If Not rFind Is Nothing Then 
   ColumnNumber = rFind.Column
   ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
   LastRow = Cells(Rows.Count, 1).End(xlUp).Row
   MsgBox ColumnLetter 
   MsgBox LastRow  
   Cells(LastRow, ColumnNumber).Value = "Here"
   Range("ColumnLetter & 2 : ColumnLetter & LastRow").Value = "2021"

       End If
   End With
   End Sub

I keep getting a method global failed error

vba excel
2 Answers

The issue is VBA sees "ColumnLetter & 2 : ColumnLetter & LastRow" as a string and is not actually using the variables ColumnLetter or LastRow. Just change it to the below and it should work fine.

Range(ColumnLetter & "2 : " & ColumnLetter & LastRow).Value = "2021"
user_71811860

Auto Fill Data Column

Option Explicit

Sub AutoFillDataColumn()

    Const hAddress As String = "A1:P1"
    Const hTitle As String = "AssessmentYear"
    Const cValue As Variant = 2021
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim hrg As Range: Set hrg = ws.Range(hAddress)
    
    Dim rg As Range: Set rg = RefDataColumnByHeader(hrg, hTitle)
    If rg Is Nothing Then Exit Sub
    
    rg.Value = cValue

End Sub

Function RefDataColumnByHeader( _
    ByVal HeaderRange As Range, _
    ByVal HeaderTitle As String) _
As Range
    
    If HeaderRange Is Nothing Then Exit Function
    
    Dim hCell As Range
    With HeaderRange
        Set hCell = .Find(HeaderTitle, .Cells(.Rows.Count, .Columns.Count), _
            xlFormulas, xlWhole, xlByRows)
        If hCell Is Nothing Then Exit Function
        If hCell.Row = .Worksheet.Rows.Count Then Exit Function
        Debug.Print "Header Cell Address:      " & hCell.Address(0, 0)
    End With
    
    Dim hrrg As Range
    Set hrrg = Intersect(HeaderRange, hCell.EntireRow)
    Debug.Print "Header Row Range Address: " & hrrg.Address(0, 0)
    
    With hrrg
        
        Dim lcrg As Range
        Set lcrg = .Resize(.Worksheet.Rows.Count - .Row).Offset(1)
        Debug.Print "Last Cell Range Address:  " & lcrg.Address(0, 0)
        
        Dim lCell As Range
        Set lCell = lcrg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If lCell Is Nothing Then Exit Function
        Debug.Print "Last Cell Address:        " & lCell.Address(0, 0)
           
        Set RefDataColumnByHeader = hCell.Resize(lCell.Row - .Row).Offset(1)
        Debug.Print "Data Column Address:      " _
            & RefDataColumnByHeader.Address(0, 0)
        
    End With

End Function
user_98140690
Related