• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

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

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

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

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

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.
 
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
 
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

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

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.
 
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.
 

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
 
Top