Pasting in a range

Z

Zapper

I need some help with this problem.

I have four ranges in the same worksheet.
For example:

rangeA (d5:d15)
rangeB (d20:d33)
rangeC (d40:d67)
rangeD (d74:d82)

I defined four names:

rangeAend (d15)
rangeBend (d33)
rangeCend (d67)
rangeDend (d82)

I want to be able to invoke a macro (Ctrl+letter)
from any cell within any of the four ranges.
The first thing I want to do is make sure the cell is in column D
and within one of the four ranges. Then I want to FILL
from that cell to the end of the range the cell is in.
And then move to one cell below the end of the range.

I'd appreciate any and all help.
 
T

Toppers

Zapper,

Hope this gets you started. I FILL the cells with X ...
wasn't sure what you wanted as FILLing!

Sub rngFill()
Dim target As Range, rng As Range
Set target = ActiveCell
ValidRng = Array("rangeA", "rangeB", "rangeC", "RangeD")
For i = 0 To 3
Set rng = Range(ValidRng(i))
If Not Intersect(target, rng) Is Nothing Then
lr = Right(rng.Address, 2) ' Last row in rng
For j = target.Row To lr
Cells(j, target.Column) = "x"
Next j
Cells(j, target.Column).Select
Exit Sub
End If
Next i
End Sub
 
Z

Zapper

Toppers,
I'm getting the message "can't execute code in break mode".
If you can get by that, I'd like to fill with what's in the active cell.
 
T

Toppers

Hi,
Change:

Cells(j, target.Column) = "x"

to

Cells(j, target.Column) = Target.value

I set with macro with Ctr+Q and it ran without any problem.

You get "can't execute in breakmode" when you are stepping through code in
VBE and then try and invoke the macro again.

Do the change above, put a value in a range and do Ctr+? (whatever you set
the macro to).
 
Z

Zapper

Topper, Thanks for the help.
Here's what I'm working with.
------------------------------------------------------------------------------------------------- A B C DE FTrans Date Description Payment DepositBalance2006 1/1 Beginning balance1,163.17EP 1/2 Cable TV 31.001,132.17 2--then this becomes the target cell for pasting downEP 1/3 AT&T Visa 103.441,028.73 1<if I delete this line, it screws up the balance (add/subtract)INT 1/10 AmSouth Interest 0.271,029.00 to the end of the range720 1/11 MACYS Visa 42.60986.40EP 1/15 Cingular Cellphone 46.21940.19EP 1/15 Brighthouse Cable 44.95895.24 -------------------------------------------------------------------------------------------------I have 5 not 4 of these ranges.The above example is basically the same for all ranges.//////////////////////////////////////////////////////////////The sub is is getting there!If the target cell is not in col F, return from the sub. <<<<< Thisworks!!!The sub is pasting in the correct range but not the correct data.Also, it pastes very slow.The sub is pasting the value in the cell rather than the (add or subtract)formula.It's pasting the value, e.g., 1,028.73I tried to paste the cell formula. I changed value to formula and itpastes the same formula from the first cell in the remaining cells in therange.I need it to increment by one all the way down, even for an inserted line.=IF(D5>0,F4-D5,F4+E5) < if this is the first cell, it pastes D5 etc all theway down=IF(D6>0,F5-D6,F5+E6) it needs to increment by one=IF(D7>0,F6-D7,F6+E7)---------------------------------------------------------------------------------------Here's the sub.Sub rngFill()Dim target As Range, rng As RangeSet target = ActiveCellValidRng = Array("rangeA", "rangeW", "rangeF", "rangeV", "rangeT") For i = 0 To 4 Set rng = Range(ValidRng(i)) If Not Intersect(target, rng) Is Nothing Then lr = Right(rng.Address, 2) ' Last row in rng For j = target.Row To lr Cells(j, target.Column) = target.Formula Next j Cells(j, target.Column).Select Exit Sub End If Next iEnd SubIf you can get this sub to paste the correct data (formula in the cells)the job is complete.Thanks again for your help.
 
Z

Zapper

Toppers,

Topper, Thanks for the help.
Sorry about that first message.
Here's what I'm working with -- a checkbook file.

-------------------------------------------------------------------------------------------------
A B C D E
F
Trans Date Description Payment Deposit Balance
2006 1/1 Beginning balance
1,163.17
EP 1/2 Cable TV 31.00
1,132.17 2--then this becomes the target cell for pasting down
EP 1/3 AT&T Visa 103.44
1,028.73 1<if I delete this line, it screws up the balance
INT 1/10 AmSouth Interest 0.27 1,029.00
to the end of the range
720 1/11 MACYS Visa 42.60 986.40
EP 1/15 Cingular Cellphone 46.21 940.19
EP 1/15 Brighthouse Cable 44.95 895.24
-------------------------------------------------------------------------------------------------
I have 5 not 4 of these ranges.
The above example is the same for all ranges.
//////////////////////////////////////////////////////////////

The sub is getting there!
If the target cell is not in col F, return from the sub. <<<<< This
works!!!
The sub is pasting in the correct range but not the correct data.
Also, it pastes very slow.
The sub is pasting the value in the cell rather than the (add or subtract)
formula.It's pasting the value, e.g., "1,028.73" all the way down.
I tried to paste the cell formula.
I changed value to formula and it pastes the same formula from the first
cell
in the remaining cells in therange.
I need it to increment by one all the way down, even for an inserted line.
=IF(D5>0,F4-D5,F4+E5) < if this is the first cell, it pastes D5 etc all
theway down
=IF(D6>0,F5-D6,F5+E6) it needs to increment by one
=IF(D7>0,F6-D7,F6+E7)
---------------------------------------------------------------------------------------
Here's the sub.

Sub FILL()
' FILL Macro
' Macro recorded 1/19/2006 by Zapper
'
' Keyboard Short cut: Ctrl+y
'
Dim target As Range, rng As Range
Set target = ActiveCell
ValidRng = Array("rangeA", "rangeW", "rangeF", "rangeV", "rangeT")
For i = 0 To 4
Set rng = Range(ValidRng(i))
If Not Intersect(target, rng) Is Nothing Then
lr = Right(rng.Address, 2) ' Last row in rng
For j = target.Row To lr
Cells(j, target.Column) = target.Formula
Next j
Cells(j, target.Column).Select
Exit Sub
End If
Next i
End Sub

If you can get this sub to paste the correct data (formula) in the cells
the job is complete.
Thanks again for your help.
 
T

Toppers

Zapper,
Try these changes which now COPY the cells and hence formula.

Sub FILL()
' FILL Macro
' Macro recorded 1/19/2006 by Zapper
'
' Keyboard Short cut: Ctrl+y
'
Dim target As Range, rng As Range
Set target = ActiveCell
ValidRng = Array("rangeA", "rangeW", "rangeF", "rangeV", "rangeT")
For i = 0 To 4
Set rng = Range(ValidRng(i))
If Not Intersect(target, rng) Is Nothing Then
lr = CInt(Right(rng.Address, 2)) ' Last row in rng
target.Copy target.Offset(1, 0).Resize(lr - target.Row)
Cells(target.Row, target.Column).Select
Exit Sub
End If
Next i
End Sub
 
Z

Zapper

Topper,
The sub is working like a charm on all but the last range (rangeT). It's
fast too.
It's hanging on the following line:
target.Copy target.Offset(1, 0).Resize(lr - target.Row)
I won't ask you to work on Sunday, I can wait.
Regards, Zapper
 
D

Dave Peterson

How about:

Option Explicit
Sub FILL2()

Dim ValidRng As Variant
Dim rng As Range
Dim i As Long

ValidRng = Array("rangeA", "rangeB", "rangeC", "rangeD")

For i = LBound(ValidRng) To UBound(ValidRng)
Set rng = Range(ValidRng(i))
If Intersect(ActiveCell, rng) Is Nothing Then
'do nothing
Else
If ActiveCell.Address = rng.Cells(rng.Cells.Count).Address Then
'in the last cell, so don't do anything
Else
ActiveCell.Copy _
Destination:=Range(ActiveCell.Offset(1, 0), _
rng.Cells(rng.Cells.Count))
End If
rng.Cells(rng.Cells.Count).Offset(1, 0).Select
Exit For
End If
Next i
End Sub
 
T

Toppers

Zapper,
See Dave P's solution - does this solve the problem? And it's
more elegant than mine!

Thanks Dave ... yet another lesson for me.
 
Z

Zapper

Dave,

You wrote "How about:".
I say "How about that!"
Your sub worked perfectly.
It will save me a lot of "dragravation".
(I have a crappy mouse.)
I can see using this routine in other spreadsheets - just set the ranges.

Could you add an UNDO feature? I Ctrl+Z a lot.

I see Toppers knows of your talent.
I appreciate his help, too.

Thanks for the sub, I'll put your name on it.

Zapper
 
Z

Zapper

Toppers,

You are right. Dave P solved the problem.
I'd like to put him on retainer.

I'm going to read this group every day.
Maybe I'll learn something about VBA.

Thanks again for your help Toppers.
Zapper
 

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

Similar Threads

Need help with Excel macro 1
Run macro on selected sheets 10
Array to Multiple Arrays 3
Clear Check Box 2
VBA 2 Codes 2
hide rows of blank cells 3
VBA Copy & Paste multiple ranges 2
Baffled with assignment of range to array why won't it work??? Anyhelp appreciated 4

Top