Automating variable multiple columns to rows

[Luke102280]

a few times a year I have to make some special signage up from three columns

A1: Item
B1: Number of Tickets to get Item
C1: How many signs are needed

so for example

A1: Gadget
B1: 100 Tickets
C1: 3

Which I have to convert into
A1: Gadget
B1: 100 Tickets
C1: Gadget
D1: 100 Tickets
E1: Gadget
F1: 100 Tickets

Column C is variable but determines how many times A and B are repeated into a single row (also a variable length divisible by 2)
</SPAN>
I thought this would be a good start but all I've done is frustrate myself.

http://www.mrexcel.com/forum/excel-...e-long-row-into-multiple-rows-14-columns.html</SPAN></SPAN></SPAN>

Any assistance would be greatly appreciated!

 

[MickG]

Perhaps this:-

[COLOR="Navy"]Sub[/COLOR] MG14Aug15
[COLOR="Navy"]Dim[/COLOR] n
[COLOR="Navy"]For[/COLOR] n = 0 To (Range("C1") - 1) * 2 [COLOR="Navy"]Step[/COLOR] 2
    Range("A1:B1").Offset(, n) = Range("A1:B1").Value
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Luke102280]

Perhaps this:-

[COLOR=navy]Sub[/COLOR] MG14Aug15
[COLOR=navy]Dim[/COLOR] n
[COLOR=navy]For[/COLOR] n = 0 To (Range("C1") - 1) * 2 [COLOR=navy]Step[/COLOR] 2
    Range("A1:B1").Offset(, n) = Range("A1:B1").Value
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Nothing happened when I ran it, copied and pasted into VBA and tried but no change to the worksheet.

 

[Luke102280]

Nothing happened when I ran it, copied and pasted into VBA and tried but no change to the worksheet.

It was running in an empty sheet, ok all that did was clear the contents of A:B and return the value from C instead of
A1: Gadget
B1: 100 Tickets
C1: Gadget
D1: 100 Tickets
E1: Gadget
F1: 100 Tickets

 

[MickG]

I you still, havel not got it working , look at this example:-
https://app.box.com/s/5v8jxpgd20bx1p2ss5ce

 

[Luke102280]

OK so I can get yours to work, but only for the first line using your sheet, if I try it on the C range it's erroring at the second line

https://app.box.com/s/2t43ce56af6smtpt9nal

I included a sample of data, expected output, and how I'm trying to format it in the end, I know I had some code snippets somewhere that would just go to the next row until it found a blank but I can't seem to find my snippet folder anywhere I've not used VBA in four years this has been so frustrating but reeducational

 

[MickG]

Try this in you basic List sheet, Results sheet3.

[COLOR="Navy"]Sub[/COLOR] MG15Aug25
[COLOR="Navy"]Dim[/COLOR] Rng                 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn                  [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Nu                  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n                   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rws                 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Col                 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw                  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c                   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Rw = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Rws = Application.Sum(Rng.Offset(, 2))
ReDim ray(1 To Rws, 1 To 16)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Nu = Dn.Offset(, 2) * 2
[COLOR="Navy"]For[/COLOR] n = 1 To Nu
    Col = IIf(n Mod 2 = 0, 1, 0)
    c = c + 1
        [COLOR="Navy"]If[/COLOR] c Mod 17 = 0 [COLOR="Navy"]Then[/COLOR]
            c = 1
            Rw = Rw + 1
        [COLOR="Navy"]End[/COLOR] If
    ray(Rw, c) = Dn.Offset(, Col)
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
 Sheets("Sheet3").Range("A1").Resize(Rws, 16) = ray
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Luke102280]

Ah that totally works! thank you. now to study how that works!

I'm assuming that if I change like below then I could expand the number of tickets on a row

Sub MG15Aug25
Dim Rng As Range
Dim Dn As Range
Dim Nu As Integer
Dim n As Long
Dim Rws As Long
Dim Col As Integer
Dim Rw As Long
Dim c As Long
Rw = 1
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Rws = Application.Sum(Rng.Offset(, 2))
ReDim ray(1 To Rws, 1 To 52)
For Each Dn In Rng
Nu = Dn.Offset(, 2) * 2
For n = 1 To Nu
Col = IIf(n Mod 2 = 0, 1, 0)
c = c + 1
If c Mod 53 = 0 Then
c = 1
Rw = Rw + 1
End If
ray(Rw, c) = Dn.Offset(, Col)
Next n
Next Dn
Sheets("Sheet3").Range("A1").Resize(Rws, 52) = ray
MsgBox "Run"
End Sub

and that would give me 26 tickets on the page right?

 

[Luke102280]

Also this can be marked as solved!

 

[MickG]

That looks about right, If it works its OK !!!!!