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