Excel macro not pasting # of cells as relative ref

[PHaydock]

Hi
Frustration over many occasions should be relieved in a flash if one of you guys can help me. I am trying to record a macro - and I don't know VB - to copy and paste rows down into blank cells - but the number of cells varies.
e.g.
A 1
2
3
B 1
2
C 1
2
3
4
D 1
My macro should copy the letter (will be "A" at first and fill the empty cells beneath using the end-down key. Once recorded, running the macro should do the same to B and C, stopping at the appropriate number of cells. BUT the macro always pasted 2 rows, not 1, then 3, etc as required. Even though I have clicked the RELATIVE button, it still records like this: - I feel the "A1:A3" is causing the prob... I think that should be flexible.
Sub Macro10()
'
' Macro10 Macro
' Macro recorded 21/08/2003 by Paul Haydock
'
' Keyboard Shortcut: Ctrl+n
'
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range("A1:A3&quot.Select
ActiveSheet.Paste
Selection.End(xlDown).Select
End Sub

Regs
PAUL HAYDOCK

 

[Molby]

Try using the below code:

Sub paste()
Selection.SpecialCells(xlCellTypeLastCell).Select
ActiveCell.Offset(0, 1).Value = "BOB"
Do Until ActiveCell.Offset(0, 1).Value = "BOB"
ActiveCell.Copy
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.Value <> &quot;&quot;
If ActiveCell.Value = &quot;&quot; Then
Selection.PasteSpecial xlValues
ActiveCell.Offset(1, 0).Select
Else
End If
Loop
Loop
End Sub

Regards,

Ian

 

[combo]

This should fill down first column in selected range (will do it for active sheet):
[tt]Sub Macro10()
With Selection
For i = 1 To .Rows.Count
If .Cells(i, 1) = &quot;&quot; Then .Cells(i, 1) = .Cells(i - 1, 1)
Next
End With
End Sub[/tt]

combo

 

[Bowers74]

This sould work too!

Sub CopyDown()
Dim c As Range
For Each c In Selection
    If c = "" And Not IsEmpty(c.Offset(0, 1)) Then
        c = c.Offset(-1, 0)
    End If
Next c
End Sub

Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[PHaydock]

Hi,
I reall yappreciate the time taken by you guys. I had expected a soft solution, but find myself struggling to use the solutions given - I don't know how to structure the solutions as I am no programmer.
The actual scenario is this (copied from Excel but 11,000 rows long.) I have to convert this database by attaching the header (col 1,2,3) for the transactions in column 4 to EACH ROW (but leaving the separating row blank... so &quot;CD 8/01/03 John Wright would be copied twice.. etc.)

col1 |col2 |col3 |col4
CD 8-Jan-03 John Wright
2517 1-1110 ANZ
2517 2-1200 Trade Creditors

CD 8-Jan-03 Rod Kerr
Global 1-1110 ANZ
Global 2-1200 Trade Creditors

CD 10-Jan-03Sam Folimo
d100103 1-1110 ANZ
d100103 6-5130 Wages & Salaries
d100103 6-5130 Wages & Salaries
d100103 2-1420 PAYG Tax Payable

A macro recorded is as follows, but this needs the code you suggest inserted into it. Could you do that for me please?
Sub Macro12()
'
' Macro12 Macro
' Macro recorded 21/08/2003 by Paul Haydock
'
' Keyboard Shortcut: Ctrl+k
'
ActiveCell.Range(&quot;A1:C1&quot.Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range(&quot;A1:C3&quot.Select
ActiveSheet.Paste
Selection.End(xlDown).Select
Selection.End(xlDown).Select
End Sub


Looking forward to this... I have to complete this task shortly... many thanks
PAUL HAYDOCK PERTH WESTERN AUSTRALIA

 

[Molby]

Try the below, not pretty but I think it will work.

Sub paste()
Range(&quot;a1&quot.Select
Do Until ActiveCell.Value = &quot;&quot; And ActiveCell.Offset(1,0).Value = &quot;&quot;
ActiveCell.Range(&quot;a1:c1&quot.Select
Selection.Copy
If ActiveCell.Offset(1, 3).Value = &quot;&quot; Then
ActiveCell.Offset(2, 0).Select
ActiveCell.Range(&quot;a1:c1&quot.Select
Selection.Copy
Else
End If
Do Until ActiveCell.Offset(1, 3).Value = &quot;&quot;
If ActiveCell.Value = &quot;&quot; Then
ActiveSheet.paste
Selection.Offset(1, 0).Select
Else
Selection.Offset(1, 0).Select
End If
Loop
ActiveSheet.paste
Loop
End Sub

 

[SkipVought]

Paul,

I Am not sure what data in your example goes with what column.

Is this the SOURCE data -- the 11,000 rows?

Or is this the result that you are looking for?

I think that Bowers has the answer for you.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[SkipVought]

Paul,

What's the reason for skipping rows between groups? This makes processing lists more difficult (using built-in functions and wizards for analysis). Lists should not have empty columns or rows.

If it's to emphasize where each group ends, why not use borders or change the row height?

Just a suggestion.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[PHaydock]

Thank you Molby, Bowers and others. SkipVougt - I don't care about the blank row. The object is to produce a csv file that I can import into an accounting database. Part of conversion to new software. Columns

col1 is CD
col2 is date
col3 is Name (eg JW)
col4 is '2517' and so on... 1-1110 ANZ
There are 11,000 rows of data. If I do it manually then I will still need to know the process of getting Excel to give me a paste which is a fill of empty cells, OR ain another macro I need... &quot;jump to the last row in the set and copy this number&quot;, etc.

Anyway, for this one...
Molby, I think I need to do some study... I can't get it to work. This is how I merged your code if my header... just guessed ...
Sub Macro19()
'
' Macro19 Macro
' Macro recorded 22/08/2003 by Paul Haydock
'
' Keyboard Shortcut: Ctrl+u
'
'Sub paste()
Range(&quot;a1&quot.Select
Do Until ActiveCell.Value = &quot;&quot; And ActiveCell.Offset(1, 0).Value = &quot;&quot;
ActiveCell.Range(&quot;a1:c1&quot.Select
Selection.Copy
If ActiveCell.Offset(1, 3).Value = &quot;&quot; Then
ActiveCell.Offset(2, 0).Select
ActiveCell.Range(&quot;a1:c1&quot.Select
Selection.Copy
Else
End If
Do Until ActiveCell.Offset(1, 3).Value = &quot;&quot;
If ActiveCell.Value = &quot;&quot; Then
ActiveSheet.paste
Selection.Offset(1, 0).Select
Else
Selection.Offset(1, 0).Select
End If
Loop
ActiveSheet.paste
Loop
End Sub

The effect was, even though I placed cursor on cell b100, (there are columns to the left that are irrelevant) is commenced at the top of the sheet and made no changes.
and the cursor was running down the 'a' column. Perhaps we just have to adjust

Bowers code... I don't know how to merge this (copy routine?) into my original Macro. Could you do this for me?

(Mmmm Why doesn't Excel just do what I record? &quot;If I say I want to shift-end down and paste then thats what I want&quot;.)

Thank you

 

[SkipVought]

Paul,

If you have a column, for instance A that has a value in A1 and a value in A10 and the row data in other columns ends at row 20, then

1. Select A2:A20

2. run bower's macro

you will see the value in A2 &quot;copied&quot; down to A9 and the value in A10 &quot;copied&quot; down to A20.

Isn't that what you neeed?

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[tmr064]

I read this solution in the Ozgrid site;

1. hilite column A cells
2. Ctrl+g ( edit | goto | special )
3. select &quot;blanks&quot;
4. select &quot;ok&quot;
5. press EQUAL (=) key
6. press UP ARROW
7. hold CTRL and press ENTER key

 

[Bowers74]

Thank you tmr064 for that,

The only problem with that it that it still leaves the formulae in the cells.

You could run it as a macro and control it a little bit more:

Sub FillTheBlanks()
With Columns("A:A")
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Copy
    .PasteSpecial (xlPasteValues)
End With
Application.CutCopyMode = False
End Sub

This does the same as you stated above, but it &quot;removes&quot; the formulae, by copying the cells and pasting the values over them.



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[Bowers74]

Hey Paul,

I re-read all of your posts here over and over again, and I believe that I know what you are trying to do now. Don't worry about your recorded macro code anymore, because the following procedure will do everything you want:

Sub CopyHeaderDown()
Application.ScreenUpdating = False
Dim LastRow As Long
Dim c As Range
LastRow = Range("B65536").End(xlUp).Row
Range("A2").Select
Do Until ActiveCell.Row >= LastRow
Set c = ActiveCell
    If Not IsEmpty(c.Offset(-1, 0)) And Not IsEmpty(c.Offset(0, 1)) Then
        c = c.Offset(-1, 0)
        c.Offset(0, 1) = c.Offset(-1, 1)
        c.Offset(0, 2) = c.Offset(-1, 2)
    End If
    ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Sorry it took so long to grip it!

I hope &quot;this&quot; helps!



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!