Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

excel vba code help

Status
Not open for further replies.

scroce

MIS
Nov 30, 2000
780
US
here's what I want to happen:

The data looks like this in column A:

fred


joe



sally

bill

What I want the code to do is copy fred into every blank cell below fred until it hits joe. Then copy joe until it hits sally, then copy sally until it hits bill etc... so the resulting column after the code runs would resemble the below:

fred
fred
fred
joe
joe
joe
joe
sally
sally
bill

This doesn't seem like it'd be that tricky, but I'm a novice excel programmer. I tried using a for each statement in combination with offset property, but i don't think that works so well.

I'd appreciate any input of how one might approach this, specific or general.

How much more water would there be in the ocean if it weren't for sponges?
 
Sub copyNames()

lastRecord = 33

For counter = 1 To lastRecord
If Range(&quot;A&quot; + LTrim(Str(counter))).Value <> &quot;&quot; Then
saveName = Range(&quot;A&quot; + LTrim(Str(counter))).Value
Else
Range(&quot;A&quot; + LTrim(Str(counter))).Value = saveName
End If
Next counter

End Sub


Be sure to change &quot;lastRecord&quot; to the appropriate
number for your spreadsheet.

- vbMax


 
Hi,
Here's another alternaitve that automatically calculates the last row as well...
Code:
Sub FillIn()
    Dim lLastRow As Long, sValue As String
    lLastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    For Each cell In Range(Cells(1, 1), Cells(lLastRow, 1))
        With cell
            If .Value <> &quot;&quot; Then
                sValue = .Value
            Else
                .Value = sValue
            End If
        End With
    Next
End Sub
Skip,
metzgsk@voughtaircraft.com
 
this macro avoids the need to edit the number of rows you require. I've assumed your starting cell is A1.

Code:
sub copycells()
dim startcell as range
set startcell = range(&quot;a1&quot;)
for i = 1 to activesheet.usedrange.rows.count - 1
if startcell.offset(i,0).value = &quot;&quot; then
startcell.offset(i,0).value = startcell.offset(i-1,0).value
endif
next i
end sub

This does the basic task you're looking for. It might be a little easier for you to follow than vbMax's example above - I don't know.

As you work with it though, you might find you need something a little more sophisticated - let me know if so. SuperBry!
 
Bry,
activesheet.usedrange.rows.count counts the number of used rows. If you did not start in row 1, you get the wrong answer. Skip,
metzgsk@voughtaircraft.com
 
... but of course, you assumed that the starting point was cells(1,1)
:) Skip,
metzgsk@voughtaircraft.com
 
Well, Skip, I did say &quot;I've assumed your starting cell is A1&quot;! ;-)

Suitably picqued at someone picking holes in my marvellous code :p, this will work and doesn't make any assumptions:

Code:
sub copycells()
dim startcell as range
if range(&quot;a1&quot;).value <> &quot;&quot; then
set startcell = range(&quot;a1&quot;)
else: set startcell = range(&quot;a1&quot;).end(xldown)
endif
for i = 1 to activesheet.usedrange.rows.count - 1
if startcell.offset(i,0).value = &quot;&quot; then
startcell.offset(i,0).value = startcell.offset(i-1,0).value
endif
next i
end sub
SuperBry!
 
I dutifully and remorsefully take my lashing. I did attempt to recover. :~/ Ha!

Naturally, we programmers would like to think that OUR code is the tightest and most concise.

I do appreciate the opportunity to view many other approaches and, hopefully, learn.
Thanx SuperBry! :) Skip,
metzgsk@voughtaircraft.com
 
I didn't get a chance to see your recovery actually Skip, having not refreshed the page. Actually, I hadn't seen that you had already posted a solution, otherwise I probably wouldn't have bothered writing my own code.

Well, there you go scroce, there's more than one way to skin a cat when it comes to programming. Just go with the solution that looks easiest to implement (and I shan't try to influence your choice in the slightest
xyxthumbs.gif
).

Just an interesting sidenote - I have to say when I see other people's solutions I nearly always say - &quot;I would never have done it like that!&quot;. I bet that's what everyone else says, too. SuperBry!
 
I didn't get a chance to see your recovery actually Skip, having not refreshed the page. Actually, I hadn't seen that you had already posted a solution, otherwise I probably wouldn't have bothered writing my own code.

Well, there you go scroce, there's more than one way to skin a cat when it comes to programming. Just go with the solution that looks easiest to implement (and I shan't try to influence your choice in the slightest
xyxthumbs.gif
).

Just an interesting sidenote - I have to say when I see other people's solutions I nearly always say - &quot;I would never have done it like that!&quot;. I bet that's what everyone else says, too. SuperBry!
 
Thank you all for your responses. The exchange of ideas is really helpful.

OK, I tried the code posted by vbMax, and I couldn't get it to work right. After too much muddling around with it, this is what I came up with:

Private Sub CopyDown()

Dim cellValue As Variant
Dim rngNames As Range
Dim nextName As String
Dim currentName As String

Set rngNames = Worksheets(&quot;myWorksheet&quot;).Range(&quot;f15:f30&quot;)
currentName = Worksheets(&quot;myWorksheet&quot;).Range(&quot;f15&quot;)

For Each cellValue In rngNames

If cellValue.Offset(1, 0).Value = &quot;&quot; Then
'MsgBox &quot;the cell is blank&quot;
cellValue.Offset(1, 0).Value = &quot;'&quot; & cellValue.Value
Else:
'MsgBox &quot;the cell isn't blank&quot;
nextName = cellValue.Offset(1, 0).Value
cellValue = nextName
End If

Next



End Sub

It's not pretty, but it seems to work. How much more water would there be in the ocean if it weren't for sponges?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top