Autofill a Named Range VBA

user_19385127 0
Viewed 38

I am trying to autofill a named range obtained from an inputbox with certain values. This is the code that I have but I keep getting Error 13 on my Set fillRange = xRgl line of code. This is the code that I have:

Dim xRg1 As Range
Set xRg1 = Application.InputBox("Range:", Type:=8)
Range("D5").Select
ActiveCell.FormulaR1C1 = "2"
Range("D6").Select
ActiveCell.FormulaR1C1 = "3"
Range("D7").Select
ActiveCell.FormulaR1C1 = "4"
Range("D8").Select
ActiveCell.FormulaR1C1 = "5"
Range("D9").Select
ActiveCell.FormulaR1C1 = "6"
Set SourceRange = Range("D5:D9")
Set fillRange = xRgl
SourceRange.AutoFill Destination:=fillRange
vba excel
1 Answers

Fill the First Column of a Range With an Ascending Integer Sequence

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Fills the first column (of the first area) of a selected range
'               with an ascending integer sequence.
' Calls:        GetAscendingIntegerSequenceColumn
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FillFirstColumn()
    Const ProcName As String = "FillFirstColumn"
    On Error GoTo ClearError
    
    Const aiPrompt As String = "Please select a range"
    Const aiTitle As String = "Range Selection"
    Const FirstInteger As Long = 2 ' adjust!
    
    If Not TypeOf Selection Is Range Then
        MsgBox "The 'Selection' is not a range.", vbCritical, ProcName
        Exit Sub
    End If
    
    Dim aiDefault As String: aiDefault = Selection.Areas(1).Columns(1).Address
    
    Dim rg As Range
    On Error Resume Next
        Set rg = Application.InputBox(aiPrompt, aiTitle, aiDefault, , , , , 8)
    On Error GoTo ClearError
    
    If rg Is Nothing Then
        MsgBox "You canceled.", vbExclamation, ProcName
        Exit Sub
    End If
    
    With rg.Areas(1).Columns(1)
        .Value = GetAscendingIntegerSequenceColumn(FirstInteger, .Rows.Count)
        MsgBox "Filled column range '" & .Address(0, 0) & "' with integers " _
            & "from " & FirstInteger & " to " & FirstInteger + .Rows.Count - 1 _
            & ".", vbInformation, ProcName
    End With
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns an ascending integer sequence
'               in a 2D one-based one-column array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetAscendingIntegerSequenceColumn( _
    ByVal FirstInteger As Long, _
    ByVal IntegerCount As Long) _
As Variant
    Const ProcName As String = "GetAscendingIntegerSequenceColumn"
    On Error GoTo ClearError
    
    Dim Data As Variant: ReDim Data(1 To IntegerCount, 1 To 1)
    
    Dim r As Long
    For r = 1 To IntegerCount
        Data(r, 1) = FirstInteger - 1 + r
    Next r
    
    GetAscendingIntegerSequenceColumn = Data
 
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function
user_98140690
Related