# Excel VBA repeat numerical series based on value in another cell or variable

##### Member
Dear All, First of all thank you very much.

Kindly help me on below problem.
I have 1 to 50 number in column A and from columns B to Z having various numbers (output of formula). I required output in form of series repeating based on values in from columns B to Z. Sample file attached. In addition how to specify the sheet and cell of workbook in macro.

#### Attachments

• 18.9 KB Views: 4

##### Member
No Sir,

Result is like AB column output. A to Z columns remain unchanged.

##### Member
Sir,
First 1 to 5 is column D output in yellow. While second two times (1 to 5) is column E output.

#### Asheesh

##### Excel Ninja
Use the below macro - attached for ref

Code:
``````Option Explicit
Option Base 1

Sub test()

Dim Seq() As Variant
Dim n As Integer, x As Integer, ColNum As Integer, sCreate As Integer, tCreate As Integer
Dim TotalSeq As Long, nElmnt As Long, p As Long
Dim cell As Range

For Each cell In Range("B51:Z51")

ColNum = cell.Column - 1
tCreate = cell.End(xlUp).Value
sCreate = cell.End(xlUp).Offset(, -ColNum).Value

If IsEmpty(Seq) Then
nElmnt = 0
ReDim Seq(1 To sCreate)
End If

For n = 1 To tCreate

For x = 1 To sCreate

ReDim Preserve Seq(1 To nElmnt + 1)

Seq(nElmnt + 1) = x

nElmnt = UBound(Seq)

Next x

Next n

Next cell

For p = LBound(Seq) To nElmnt

'Change the column Name here to paste the results where you want

Range("AC" & p + 1).Value = Seq(p)

Next p

End Sub``````

#### Attachments

• 28.1 KB Views: 1
• ##### Member
Dear Sir,

Thank you very for spending your valuable time.
Macro work perfect as per sample data.
However my actual data set attached in file along with one macro. It is working in one file. When I have created other file macro is not working. Attached file data from BW2 to CR51 varies depending upon requirement. If required number of columns and row can be increased.

#### Attachments

• 298.8 KB Views: 3

#### Asheesh

##### Excel Ninja

Did you change the ranges to fit your requirement?

• ##### Member
No sir. I have just added few values in column B. Output is not as per the change data as per your suggested macro. Hence, I have attached new file. In that file macro working. But when I have added same macro in new file. It is not working. I don't why. Kindly suggest me to revised macro that work in new file.

##### Member
Dear Sir,
I have downloaded your file and it working perfect. Same macro I have copied and run on repeat series.rar file by changing range. There it giving massage as type mismatch. In attached rar file my data in green colour which is output of formula based on my requirements. I require output in second next column. I am not having much knowledge in macro. Thank you very much once again.

#### Asheesh

##### Excel Ninja
I have done an interim fix, however, will fine tune the snippet tomorrow. Time to go !!

Code:
``````Option Explicit
Option Base 1

Sub test()

Dim Seq() As Variant
Dim n As Integer, x As Integer, ColNum As Integer, sCreate As Integer, tCreate As Integer
Dim TotalSeq As Long, nElmnt As Long, p As Long
Dim cell As Range

Sheets("Calc").Activate
For Each cell In Range("BW2:CR2") ' You need to change the range here

cell.Select

Do While ActiveCell <> ""

ColNum = ActiveCell.Column - 1
tCreate = ActiveCell.Value
sCreate = Range("BV" & ActiveCell.Row)

ActiveCell.Offset(1, 0).Select

Loop

If IsEmpty(Seq) Then
nElmnt = 0
ReDim Seq(1 To sCreate)
End If

For n = 1 To tCreate

For x = 1 To sCreate

ReDim Preserve Seq(1 To nElmnt + 1)

Seq(nElmnt + 1) = x

nElmnt = UBound(Seq)

Next x

Next n

Next cell

For p = LBound(Seq) To nElmnt

'Change the column Name here to paste the results where you want

Range("CT" & p + 1).Value = Seq(p)

Next p

End Sub``````

• ##### Member
Dear Sir,

Macro working perfectly when all column having data. However if any column in between is blank then series is not correct. for example there were no data in BY, CA, CN or CR column or any other column changing as per requirement then series is not correct.

#### p45cal

##### Well-Known Member
Since all the values in the table(s) are created by formulae which get their values from a small 2-row range (AY2:BT3), it turns out it's easier to get your sequence from that small range directly.
In the attached is button near cell CW1 which runs a macro which asks for that range, and asks for where you want the results. It completely bypasses looking at the tables.
The code:
Code:
``````Sub blah()
'un-comment the next line if you have Option Explicit at the top of the code module.
'Dim ResultArray(), myRng As Range, ArraySize As Long, cll As Range, i, j, idx As Long, Destn As Range
Set myRng = Application.InputBox("Select the 2-row source range", "Source Range", "AY2:BT3", , , , , 8)
ArraySize = Application.SumProduct(myRng.Rows(1).Value, myRng.Rows(2).Value)
ReDim ResultArray(1 To ArraySize, 1 To 1)
For Each cll In myRng.Rows(1).Cells
For i = 1 To cll.Value
For j = 1 To cll.Offset(1).Value
idx = idx + 1
ResultArray(idx, 1) = j
Next j
Next i
Next cll
Set Destn = Application.InputBox("Select the top cell where you want the results", "Destination", "CT2", , , , , 8)
Destn.Resize(idx).Value = ResultArray
End Sub``````

#### Attachments

• 42.9 KB Views: 1
• ##### Member
Dear Sir,
Still having error. However I have attached file where macro is working. But same macro when I have copied to another file i is not working. My data range BV to CR. I do not know how to make that change. if possible can you suggest me how to change input data range or flexibility in macro itself to specific range.
Thank you very much for spending time.

#### Attachments

• 27.3 KB Views: 1

##### Member
Really sorry Sir,

I have selected wrong range. I working perfect. However, is it possible to include range (AY2:BT3) or as per requirement inside macro and not a massage box.

#### Marc L

##### Excel Ninja
a massage box.
Thaï or Chinese the massage ?! ##### Member
Code:
``````Sub blah()
'un-comment the next line if you have Option Explicit at the top of the code module.
'Dim ResultArray(), myRng As Range, ArraySize As Long, cll As Range, i, j, idx As Long, Destn As Range
'Set myRng = Application.InputBox("Select the 2-row source range", "Source Range", "AY2:BT3", , , , , 8)
Set myrng = Application.Range("AY2:BT3")
ArraySize = Application.SumProduct(myrng.Rows(1).Value, myrng.Rows(2).Value)
ReDim ResultArray(1 To ArraySize, 1 To 1)
For Each cll In myrng.Rows(1).Cells
For i = 1 To cll.Value
For j = 1 To cll.Offset(1).Value
idx = idx + 1
ResultArray(idx, 1) = j
Next j
Next i
Next cll
'Set Destn = Application.InputBox("Select the top cell where you want the results", "Destination", "CT2", , , , , 8)
Set destn = Application.Range("CT2")
destn.Resize(idx).Value = ResultArray
End Sub``````
Working sir,
Thank you very much for your valuable time.

##### Member
Dear Sir,
Working perfect as per my requirement.
Thank you very much for spending your valuable time.

#### p45cal

##### Well-Known Member
However, is it possible to include range (AY2:BT3) or as per requirement inside macro and not a massage box.
In that case:
Code:
``````Sub blah()
'un-comment the next line if you have Option Explicit at the top of the code module.
'Dim ResultArray(), ArraySize As Long, cll As Range, i, j, idx As Long, Destn As Range
With Range("AY2:BT3")
ArraySize = Application.SumProduct(.Rows(1).Value, .Rows(2).Value)
ReDim ResultArray(1 To ArraySize, 1 To 1)
For Each cll In .Rows(1).Cells
For i = 1 To cll.Value
For j = 1 To cll.Offset(1).Value
idx = idx + 1
ResultArray(idx, 1) = j
Next j
Next i
Next cll
End With
Range("CT2").Resize(idx).Value = ResultArray
End Sub``````