Using two counters to create data

[tholder]

I have a list of about 40 rows, and each row has an ID, year, and total value. I need to create a row with the ID and Year and a number starting at one up and going the total value.

For example, if row one of my data was
12 2011 3

I would need to create
12 2011 1
12 2011 2
12 2011 3


This is what I have, but when I run it nothing happens.

Sub barCodeSheet()
Dim maxVal As Long, id As Long, year As Long

For Counter = 1 To maxVal
Location.Value = Counter
Location.Offset(0, -1).Value = year
Location.Offset(0, -2).Value = id
Set Location = Location.Offset(1, 0)
Next Counter

End Sub

Sub retrieve()
Dim maxVal As Long, id As Long, year As Long, Row_Count As Long

Row_Count = Application.CountA(Range("A:A"))

Set Location = Cells(6, 2)

For Counter = 2 To Row_Count

id = Cells(Counter, 1).Value
maxVal = Cells(Counter, 4).Value
year = Cells(Counter, 3).Value

Call barCodeSheet

Next Counter

End Sub

 

[JackDanIce]

Not sure if I've understood your query but I'm going to make the following assumptions (these can all be changed to accomodate but to get something working this will do):

-You have no header rows
-Your example of 12 2011 3 are in cells A1, B1 and C1 respectively
- The output will start in cell E1 and be on the same sheet

Given this, try:

Sub TurtlesCanSwim()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Dim i As Long, j As Long, k As Long, L As Long
k = 1
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("C" & i) > 0 Then
    L = 1
        For j = Range("C" & i) To 1 Step -1
            Range("A" & i & ":B" & i).Copy
            Range("E" & k).PasteSpecial xlPasteAll
            Range("G" & k) = L
            k = k + 1
            L = L + 1
        Next j
    End If
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

 

[tholder]

Oh that worked perfectly. Very different approach, clever! Thanks a lot. And I love the sub name.

 

[JackDanIce]

Thank you and thank you! I was just being creative with the sub name, seem to be doing that alot lately.

I don't know why I made the 'L' variable capital and i, j and k all lower case, typo - no esoteric reason anyway.

Generally speaking as your data size increases, nested loops aren't the best way to work through data but I'm not sure (in this instance) what other solutions there are, so curious if anyone else can post something faster/more efficient.

Anyway, glad it works,
Jack

 

[tholder]

After I used your code for what I needed done immediately I went back and got my code to work. Works pretty slick actually.

Sub barCodeSheet(maxval As Long, id As Long, year As Long, Location As Range)

    For Counter = 1 To maxval
        Location.Value = Counter
        Location.Offset(0, -1).Value = year
        Location.Offset(0, -2).Value = id
        Set Location = Location.Offset(1, 0)
    Next Counter
    
End Sub

Sub retrieve()
Dim maxval As Long, id As Long, year As Long, Row_Count As Long, Location As Range

    Row_Count = Application.CountA(Range("A:A"))
    
    Set Location = Range("f2")
    
    For Counter = 2 To Row_Count
    
        id = Cells(Counter, 1).Value
        maxval = Cells(Counter, 3).Value
        year = Cells(Counter, 2).Value

        barCodeSheet maxval, id, year, Location
    
    Next Counter

End Sub

 

[JackDanIce]

Thanks, I'll have a look at that when I get home