Copy Paste Macro

[nina1]

I am new to VBA and I need help for a simple macro that will look at the value in A column "Part" and copy the value of B column down till it gets to the "Part " again and loop to the end.
It should looks like something like this:

Part 3222-01
3222-01
3222-01
3222-01
Part 3444-02
3444-02
3444-02

 

[DaveInIowa]

What stops the copy process? Surely you don't want "3444-02" copied down to the last available row of the spreadsheet do you?

 

[nina1]

Column A "Part" should stop the copy process.

Right now it looks like this:

Part 3222-01
Empty
Empty
Empty
Part 3444-02
Empty
Empty
Empty
Part 3555-03
Empty
Empty
Empty
and so on and I need it like this
Part 3222-01
3222-01
3222-01
Part 3444-02
3444-02
3444-02

and so on

 

[DaveInIowa]

According to what you're asking for in your example, column B, rows 9 through 1048576 will contain 3555-03. In other words, where's the "Part" that stops 3555-03 from being copied?

 

[nina1]

The excell sheet contains 17000 rows with data and there are multiple part numbers that are displayed in the order I displayed, the last set of part will look like this

Part 03999-01
empty cell
empty cell
empty cell
empty cell
empty cell

 

[MakeItSo]

Yes, but what we need to know in order to help you is:
how can the macro know when to terminate processing that final set?
If you have 17,000 rows, then after "Part" there will be more than 48,000 empty lines!
Having nothing but "Part" as a distinguisher of sets, your last set will then contain 48,535 lines reading "03999-01".

Do these "Part" sections all have equal length, i.e. do they all span 4 (or 3, or 5...) lines?

Cheers,
miS

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[nina1]

The "Part" section doesn't have equal number of rows, sometimes it might be more then 10 rows in one section. The last 'Part" in column A can be used to terminate the process even if I have to do a couple of rows manualy it is better then doing 17000 rows.
Thanks a lot for your help!

 

[DaveInIowa]

Try this:

Public Sub CopyPartNumbers()
    Dim rw As Long
    Dim emptyCells As Long
    
    rw = ActiveSheet.UsedRange.Rows.Count
    
    Do While (rw > 0)

        If (IsEmpty(ActiveSheet.Cells(rw, 2))) Then
            emptyCells = emptyCells + 1
            
        ElseIf (emptyCells > 0) Then
            ActiveSheet.Cells(rw, 2).Resize(emptyCells + 1, 1).Value = ActiveSheet.Cells(rw, 2).Value
            emptyCells = 0
        End If
        
        rw = rw - 1
    Loop
    
End Sub

 

[Gavona]

This is a routine I use for the task. It avoids looping so is probably a fair bit quicker to run than the more timely solution posted earlier.

Sub FillBlanks()
With Selection
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
    .Copy
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With
End Sub

Just select the range containing the blank cells and run the sub. I use it with pivot table data (copied to values first so no longer a pivot table).

Gavin

 

[MakeItSo]

...even if I have to do a couple of rows manualy it is better then doing 17000 rows.

Even if you are doing it manually, there must be some info somewhere to tell you how many rows you have to copy manually.
This info can also be used to terminate the process - no manual copying needed then.

How do you know how many rows you'll need? From another column? Another Sheet? Another workbook?

The info is out there, somewhere...

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[TonyJollans]

Do you really need a macro?

In C1 put something along the lines of [blue][tt]=IF(A1="Part",B1,OFFSET(C1,-1,0))[/tt][/blue] and copy down as far as you want.

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[eVAPor8]

Here's a quick'n nasty FillDown routine.

Note: Do NOT select Row 1 if it's an empty cell, the macro will error out (obviously - there is no "Row -1" )
and look for possible "No-String/Empty String/Null String" gotchas but it should do the job.

Public Sub FillDown()
    Dim cell As Object
    For Each cell In Selection
        If cell.Text = "" Then cell = cell.Offset(-1, 0).Value
    Next cell
End Sub

Select your range in column B and Run it.

I used to be the Comaboy on Tek-Tips.

...And the despicable Jeremy Vyle elsewhere.

 

[nina1]

Thanks a lot to everybody, offset function worked perfect