Create an Array to fill a Range

[jollynicechap]

I'm trying to create a workbook of labels using an array to fill a range of
cells A4 to P75 from a user input box or boxes. The order should be A4:A75
through to P475. i.e. A4 = 1 to A75 = 72 etc. I would like to expand the
user input for text as well as numerical data, where the text element would
be fixed and the numerical data would be sequential. e.g. 7F/01-001

The following sub (borrowed from Excel 2000 Power Programming with VBA)
works but in rows instead of cols.

My VBA ability is very, very rusty & I could use some help.

TIA

Sub ArrayFillRange()

' Fill a range by transferring an array
Dim TempArray() As Integer
Dim TheArray As Range

' Get the dimensions
CellsDown = Val(InputBox("How many cells down?"))
CellsAcross = Val(InputBox("How many cells across?"))

' Redimension temp array
ReDim TempArray(1 To CellsDown, 1 To CellsAcross)

' Set worksheet range
Set TheRange = ActiveCell.Range(Cells(1, 1), Cells(CellsDown,
CellsAcross))

' Fill the temp array
Currval = 0
Application.ScreenUpdating = False
For i = 1 To CellsDown
For j = 1 To CellsAcross
TempArray(i, j) = Currval + 1
Currval = Currval + 1
Next j
Next i

' Transfer temp array to worksheet
TheRange.Value = TempArray

End Sub

 

[Dave Peterson]

Sometimes, you can let excel work with you by applying the same formula to each
cell in the range and let it figure out what the real numbers should be.

Try selecting any 10 row by 4 column range (say E5:H14) and with E5 the active
cell, type this:

=TEXT(ROW(A1)+(COLUMN(A1)-1)*10,"0000")
But hit ctrl-enter to fill the whole range with the formulas.

This routine does that same thing.

Option Explicit
Sub testme()
Dim myRng As Range
Dim myFormula As String
Dim myPfx As String

Set myRng = Nothing
On Error Resume Next
Set myRng = Application.InputBox(Prompt:="Select a rectangular area", _
Default:=Selection.Areas(1).Address, Type:=8).Areas(1)
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "try later"
Exit Sub
End If

If myRng.Rows.Count < 2 _
Or myRng.Columns.Count < 2 Then
MsgBox "do it yourself!"
End If

myPfx = InputBox(Prompt:="Type your prefix:")

myPfx = "'" & myPfx


myFormula = "=" & Chr(34) & myPfx & Chr(34) _
& "&text(ROW(a1)+(COLUMN(a1)-1)*" _
& myRng.Rows.Count & ",""0000"")"

With myRng
.NumberFormat = "General"
.Formula = myFormula
.Value = .Value
End With

End Sub

 

[jollynicechap]

Dave

The code works perfectly and is better for the user as it asks for
rectangular area and not a specific number range! For my purposes I would
change the formula to *72 for the correct results.

Thank you very much

P

 

[Dave Peterson]

Yep. You'd want to multiply by the number of rows in that range. I used 10
just so I wouldn't have to scroll through a lot of rows for my example.