View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
ML0940 ML0940 is offline
external usenet poster
 
Posts: 47
Default If one range changes, update the other

Ossie
Here are my findings.
First of all, you are doing a great job because I would not have gotten this
far along without your help and it is working pretty darn good now.

Ok, On worksheet 2, if there is a blank row just below the last row in the
named range, then the macro works perfect.
If there is data in the row directly below the last row in the named range,
it is getting overwritten. Then explains the first problem, as I have a
merged cell just below the range on Worksheet 2.

So, it looks like a row is being added to the range, but not to worksheet 2.
if we insert a row into the first range manually, of course it will work but
we need to also insert that row in Worksheet 2. It isn't enough to just paste.

To demonstrate what I am explaining, put some text into the cell directly
below range 2, then in The code, add On Error Resume Next, above
ActiveSheet.Paste

You will then seehow range 2 is growing but no new cells are being added to
the collection in Worksheet 2

Thank you
Mark



"OssieMac" wrote:

My apologies. Further testing of the macro has shown up problems trying to
copy and paste and/or trying to make a named range = another named range.

Basically the second named range is not getting updated with the new range
when rows are inserted/deleted.

I cannot get the macro to work properly without select-copy-
select destination-paste.

The reason is that the pasted area becomes the new selection that can be
renamed.

In the interactive mode, inserting and deleting rows in a named range alters
the range for the named range. I intended doing this in the code but the
named range is not getting updated with the new range when the insert or
delete is done via a VBA.

You need to understand that while I completely agree with the principle of
copy/paste without selecting the ranges; in this case the selection is
required because I don't know of any other way of identifying the range to
update the named range.

Amended code below.

Private Sub Worksheet_Change(ByVal Target As Range)

'Exit Sub 'Use this to suppress macro
'if you want to fix corrupted data
'during the testing process or
'at any later date.

Dim isect As Object 'Target
Dim rngSh1 As Range 'Range("Sh1billsW")
Dim rngSh2 As Range 'Range("Sh2billsW")
Dim lngCols As Long 'Number Columns in named ranges
Dim lngRowsSh1 As Long 'Number Rows in Range Sh1billsW
Dim lngRowsSh2 As Long 'Number Rows in Range Sh2billsW
Dim lngDiff As Long 'Difference in number of rows

Set isect = Intersect(Target, Range("Sh1billsW"))

If Not isect Is Nothing Then

Application.EnableEvents = False

'Assign each named range to VBA variables
With Sheets("Sheet1")
Set rngSh1 = .Range("Sh1billsW")
End With

With Sheets("Sheet2")
Set rngSh2 = .Range("Sh2billsW")
End With

'Assign number of rows in each range to VBA variables
lngRowsSh1 = rngSh1.Rows.Count
lngRowsSh2 = rngSh2.Rows.Count

'Assign number of columns in each range to VBA variable
'(Assumes both ranges have same number of columns)
lngCols = rngSh1.Columns.Count

'Assign difference in number or rows to VBA variable
lngDiff = lngRowsSh1 - lngRowsSh2

'Test if numnber rows same, greater or less than
Select Case lngDiff
Case 0 'Number of rows unchanged
MsgBox "No rows inserted or deleted"
'Case 0 for testing purposes only and
'can be deleted when testing finished
Case Is 0
'INSERT rows in Range("Sh2billsW")
With rngSh2
.Range(.Cells(2, 1), _
.Cells(2 + lngDiff - 1, lngCols)) _
.Insert Shift:=xlDown
End With

Case Is < 0
'DELETE rows in Range("Sh2billsW")
'Note removal of negative from lngDiff with ABS function
With rngSh2
.ClearContents
.Range(.Cells(2, 1), _
.Cells(2 + Abs(lngDiff) - 1, lngCols)) _
.Delete Shift:=xlUp
End With
End Select

'Copy data
Sheets("Sheet1").Range("Sh1billsW").Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Range("Sh2billsW").Select
ActiveSheet.Paste
ActiveWorkbook.Names.Add Name:="Sh2billsW", _
RefersToR1C1:=Selection

End If

Application.EnableEvents = True

End Sub


--
Regards,

OssieMac