On Feb 8, 8:50 pm, "haas...@yahoo.com" <haas...@yahoo.com> wrote:
> On Feb 8, 3:38 pm, stj...@hotmail.com wrote:
>
>
>
> > On Feb 8, 6:58 pm, "haas...@yahoo.com" <haas...@yahoo.com> wrote:
>
> > > Hi all!
>
> > > I posted this earlier and haven't received any help and I kind of need
> > > to have this done by the end of the day today. If you can please help
> > > with this, it'll be truly appreciated. Here's what I have:
>
> > > In cells A5 to A12, I have names of people (no
> > > duplicates.) In cells B5 to B12 I have numbers next to the names. I
> > > need to write a code which will start by allowing me to look at the
> > > number in B5 and copy the name in A5 and start pasting it in cell D15
> > > and then D16 and so on (down the row) as many times as represented by
> > > the number in cell B5. Then, the code should look at cell B6 and
> > > depending on the number in there, start pasting the name in A6 that
> > > many times in whichever cell in column D is next empty. The code will
> > > stop as soon as it encounters a 0 value in any cell in B5 to B12.
>
> > > For the purposes of an example, please see the following:
> > > A B
> > > Dave 4
> > > John 3
> > > Brad 2
> > > Jack 0
> > > Jane 0
> > > Bart 0
> > > Kate 0
> > > Kent 0
>
> > > The code will essentially copy Dave first, and then paste it 4 times
> > > in cells D15, D16, D17, and D18. Next, it will copy John 3 times and
> > > paste it in D19, D20, and D21. Next it will go to Brad, and copy it 2
> > > times, and paste it in D22 and D23. Next, it will go to Jack, and the
> > > code will stop there becaus eit encounters a 0.
>
> > > I hope the example helps illustrate what i need. If you have any
> > > questions, please don't hesitate to ask.
>
> > Try this:
>
> > Sub x()
> > Dim rng As Range
> > Dim r As Long
>
> > r = 15
> > For Each rng In Range("A5:A12")
> > If rng.Offset(, 1) <> 0 Then
> > Cells(r, "D").Resize(rng.Offset(, 1)) = rng
> > r = r + rng.Offset(, 1)
> > Else
> > Exit Sub
> > End If
> > Next rng
>
> > End Sub- Hide quoted text -
>
> > - Show quoted text -
>
> That works perfect. Thank you sooooo much! One last question - If the
> first name (in cell A5) has a 0 next to it, I want to be able to go to
> the second cell (A6) and start the loop from there. If A6 has a value
> next to it, then i need it copied and pasted that many times. If it
> has a 0 next to it, then i want the code to end right then and there.
> Thanks again for your help...absolutely amazing!
This should do it.
Sub x()
Dim rng As Range
Dim r As Long
r = 15
For Each rng In Range("A5:A12")
If rng.Address = "$A$5" And rng.Offset(, 1) = 0 Then GoTo line0
If rng.Offset(, 1) <> 0 Then
Cells(r, "D").Resize(rng.Offset(, 1)) = rng
r = r + rng.Offset(, 1)
Else
Exit Sub
End If
line0:
Next rng
End Sub
|
Similar Threads
