VBA Loop Code

D

D. Stacy

I have three column of data and I would like to use VBA code to go loop thru
the rows of data and then write output to another worksheet.

Value Range Label
1400 175 Red
2400 112 Blue
9000 710 Green

The output table (range) would look something like


1400 Red
1401 Red
1402 Red
1403 Red
....
....
....
...
2400 Blue
2401 Blue
etc. etc.


Thanks in advance!
 
M

Mike H

Hi,

Try this. Change SrcSheet & DestSheet to the correct sheets

Sub sonic()
Dim x As Long
Dim SrcSheet As String
Dim DestSheet As String
SrcSheet = "Sheet1"
DestSheet = "Sheet2"
x = 2
LastRow = Sheets(SrcSheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets(SrcSheet).Range("A2:A" & LastRow)
For Each c In MyRange
Sheets(DestSheet).Cells(x, 1) = c.Value
Sheets(DestSheet).Cells(x, 2) = c.Offset(, 2).Value
x = x + 1
Next
End Sub

Mike
 
R

Rob van Gelder

What happens when you get to 9000. Is this also printed, and do you keep going past 9000, 9001, 9002, etc? Where do you stop?

This code assumes 9000 is not printed:


Sub test()
Const cFirstRow = 2
Const cValueCol = 1, cColourCol = 3
Dim i As Long, lng As Long, lngLimit As Long, strColour As String
Dim rngDest As Range

Set rngDest = Sheet2.Cells(1, 1)

With Sheet1
i = cFirstRow
lng = .Cells(i, cValueCol)
Do
strColour = .Cells(i, cColourCol)
i = i + 1
lngLimit = .Cells(i, cValueCol)
If lngLimit = 0 Then Exit Do

Do
rngDest = lng
rngDest.Offset(0, 1) = strColour
Set rngDest = rngDest.Offset(1)
lng = lng + 1
Loop While lng < lngLimit
Loop
End With
End Sub


Cheers,
Rob
 
D

Don Guillett

Try this using autofill instead

Option Explicit
Sub fillinnumsSAS()
Dim ss As Worksheet
Dim ds As Worksheet
Dim slr As Long
Dim dlr As Long
Dim i As Long
Dim mc As Long
Set ss = sheets("Sheet20")
Set ds = sheets("Sheet21")
slr = ss.Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
For i = 2 To slr
dlr = ds.Cells(Rows.Count, 1).End(xlUp).Row
mc = ss.Cells(i + 1, 1) - ss.Cells(i, 1)
With ds
.Cells(dlr, 1) = ss.Cells(i, 1)
.Cells(dlr, 2) = ss.Cells(i, 3)
.Range(.Cells(dlr, 1), .Cells(dlr, 2)).AutoFill _
Destination:=.Range(.Cells(dlr, 1), .Cells(dlr + mc, 2))
End With
Next i
End Sub
 
D

Don Guillett

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.
 
R

Rob van Gelder

Here you go...

Sub test()
Const cFirstRow = 2
Const cValueCol = 1, cRangeCol = 2, cColourCol = 3
Dim i As Long, lng As Long, lngLimit As Long, strColour As String
Dim rngDest As Range

Set rngDest = Sheet2.Cells(1, 1)

With Sheet1
For i = cFirstRow To .Cells(Rows.Count, cValueCol).End(xlUp).Row
lng = .Cells(i, cValueCol)
lngLimit = .Cells(i, cRangeCol)
strColour = .Cells(i, cColourCol)
For lng = .Cells(i, cValueCol) To .Cells(i, cValueCol) + .Cells(i, cRangeCol)
rngDest = lng
rngDest.Offset(0, 1) = strColour
Set rngDest = rngDest.Offset(1, 0)
Next
Next
End With
End Sub

Cheers,
Rob
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top