PDA

View Full Version : Updating duplicate worksheet



dgt
08-04-2009, 05:06 AM
Hi all

I had to create a temporary duplicate spreadsheet in my workbook and this simply links itself on a cell by cell basis from Sheet1 to Sheet2.

As with my other recent posts, I then tried to make Sheet2 update itself whenever data is entered or changed in Sheet1.

However despite my efforts to incorporate "Worksheets(Sheet2).Calculate" into the existing code (see below) in Sheet1, nothing worked.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$3" Then Exit Sub
ActiveSheet.Calculate
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Col As Long
Dim i As Integer, x As Integer
Dim LastRow As Long
Dim StartCell As String
Dim StartRow As Long

StartCell = "G5"

With Range(StartCell)
Col = .Column
StartRow = .Row
LastRow = Cells(Rows.Count, Col).End(xlUp).Row
End With


For i = StartRow To LastRow
If Cells(i, 2).Value <> "" Then
x = x + 1
Cells(i, 1).Value = "S" & x
End If
Next i
End Sub

I believe that I am correct in saying that this should be triggered as a Worksheet_Change and that you can only have one of these in a worksheet.

Once again not sure what I am doing wrong but just not getting it right!

TIA ...DGT

PS: How do I mark my previous threads as solved?

Bob Phillips
08-04-2009, 05:28 AM
I don't see how this code updates Sheet2, it just seems to act on Sheet1.

You could simply do



Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("Sheet2").Range(Target.Address).Value = Target.Value
End Sub

dgt
08-04-2009, 06:28 AM
Hi xld

Thanks for quick reply.

Yes, you are correct in that the code shown refers to Sheet1. I included this so that you could see the existing code on Sheet1.

As I understand you can only use "Private Sub Worksheet_Change(ByVal Target As Range)" once in a worksheet; so the code to update Sheet2 would have to be incorporated within the existing "Worksheet_Change".


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$3" Then Exit Sub
ActiveSheet.Calculate
End Sub



I have tried using "End If" and some other combinations but none of them worked. So I am hoping you can put this together as one piece of code.

Thanks ...DGT

Bob Phillips
08-04-2009, 08:08 AM
You just have an extra test, something like this



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$3" Then

ActiveSheet.Calculate
ElseIf Not Intersect (Me.Range("G1:G10"), Target) Is Nothing Then

Worksheets("Sheet2").Range(Target.Address).Value = Target.Value
End If
End Sub

dgt
08-04-2009, 09:12 AM
Sorry xld but it is just not working, nothing changes on Sheet2.

I tried expanding the range to A1:Q413 but this threw up a compile error.

I tried substituting Worksheet(2).Calculate to see if that helps but without success.

Even when $B$3 is the active cell (a date) and I change this to produce a new set of figures in Column B, the "ActiveSheet.Calculate" in Sheet1 changes the column of figures but nothing changes in Sheet2.

DGT

Bob Phillips
08-04-2009, 10:40 AM
What that code does is to update the corresponding cell on sheet2 when a cell on sheet1 in that target range changes, a straight copy.

dgt
08-04-2009, 03:17 PM
Xld, now I understand.

I made up a fresh 'Sheet2' just using Values & Formats, amended the range and it works as it should do with your code.

My previous 'Sheet2' was linked to 'Sheet1' by formulas
e.g. A1=Sheet1!A1
which is why I was trying to use "Worksheet().Calculate" to update the duplicate worksheet.

Obviously, these formulas conflicted with the code in some way!

Thanks for your help ...DGT

dgt
08-05-2009, 04:10 AM
Hi xld

Not sure if you will spot this post but I tried to make use of this code in a slightly different situation; whereby the destination cells are in a different position on another worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Me.Range("A300:G600"), Target) Is Nothing Then

Worksheets("Input2").Range("A9050:G9350").Value = Target.Value
End If
End Sub

As you will see the source range on the active worksheet is "A300:G600" and the range on the 'Input2' worksheet is "A9050:G9350", however my feeble attempts did not work!

Eventually, I hope to make the source range fixed but I will have to amend the range in the code on a weekly basis for the destination; as this will change every week.

Your help would be much appreciated ...DGT

Bob Phillips
08-05-2009, 04:24 AM
To test whether the changed cell is within a range, you use If Not Intersect. You are testing for any cell other than A300:G600 being changed (try it).



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Me.Range("A300:G600"), Target) Is Nothing Then

Worksheets("Input2").Range("A9050:G9350").Value = Target.Value
End If
End Sub

dgt
08-05-2009, 05:24 AM
Hi xld

Thanks for the info and amended code. However, I am getting some really wierd results as you will see from the attached example workbook.

I originally just changed the dates on Column A (Input3) but everything else was filled in across the range but incorrectly. The formatting has changed and even when corrected, still reverts back to how you see it now.

Confused as ever ...DGT

rbrhodes
08-05-2009, 10:35 PM
Hi DGT.

Are you trying to get:

Input3.Range("A300:G300")

to copy to

Input2.Range("A9050:G9050")

If so see attached.

dgt
08-09-2009, 04:29 AM
Hi rbrhodes

Essentially yes, I am trying to get the

Input3.Range("A300:G300")

to copy to

Input2.Range("A9050:G9050")

although the full range is Input3.Range("A300:G600") copying to Input2.Range("A9050:G9350"). However the Input3 range may increase or decrease each week but not a problem if the code is adjustable.

Once the Input2 range is filled for that week, the following week will need to start from the 1st blank row below that. e.g If A9350:G9350 is the last one for week ending 1/8/09 then the new weeks entries would need to be filled from A9351:G9351 downwards. Again, not a problem if the code is adjustable.

Your code works fine on a line by line basis but in many cases I also need to simply copy and paste blocks of data to save time. When attempting to do this, only the 1st line (row) appears on the Input2 worksheet. In fact, when I first start on the figures, I change the date in column A (Input3) to the new date for all rows but again only the 1st cell i.e. A300 appears in the Input2 worksheet along with any data in the adjoining columns.

Any ideas on how to make this code work the way that I need it to?

Regards ...DGT

dgt
08-09-2009, 04:59 AM
Hi xld

I have been trying to experiment with your code but no matter what I do all cells in the destination range in Input2 become formatted as a date and even empty (blank) cells are copied over with the same date as column A.

Any suggestions?

DGT

Aussiebear
08-09-2009, 06:48 PM
Hi dgt, This is occuring because you are copying the existing format from Sheet 1 to sheet 2. If you require a different date format, then it will need to be included in the procedure code, to be acted upon after the copying has occurred.

rbrhodes
08-09-2009, 07:33 PM
Hi,

Had another look at your example and it looks to like you're trying to copy over 300 rows of data from Input3 to Input2. So:

What this does when you Doubleclick in a date cell on Input3:

- Reads the 'WeekRows' variable as set by the user (you). Right now it is set as 300.

(So anywhere you see 300 in this explanation remember it is a variable set by you.)

- Determines if it's first/last or somewhere in the 300 row range of that date on sheeet 'Input1'

- Calculates 300 rows by 7 cols and copies them

- Attempts to find the doubleclicked date in sheet 'Input2'

- If found, calculates where to put the new data and pastes it over the old

- If not found, calculates the next range of 300 rows start point on 'Input2' and pastes data there

Notes:

- If any previous data overran the 300 row limit it will jump to the next 300 row set and paste there

- If Col A in 'Input2 is NOT formatted as date, it will fail

dgt
08-15-2009, 06:18 AM
Hi AussieBear

Not had time to get back to this until now.

Only Column A is formatted as a date ??/??/?? and I have checked all of the other forrmatting to ensure they are correctly set. I have also made sure that both sheets have matching formatting.

After that when you run the code it appears to copy the initial changed range correctly but when run again, all of the destination range becomes formatted as dates including the empty cells.

Incidentally, the data is normally copied from Input3 to Input2 around 40-50 rows at a time. Then I run a save or refresh pivot table so that the results can be checked against a double entry system.

Having made use of XLDs code in another worksheet, I cannot understand why it does not work in this situation.

Any ideas ...DGT

dgt
08-15-2009, 06:34 AM
Hi rbrhodes

Not had time to get back to this until now.

The code looks great and seems to work fine and copies all of the 300 rows of data across but I may not have explained my self clearly because
the data is normally copied from Input3 to Input2 around 40-50 rows at a time. Then I run a save or refresh pivot table so that the results can be checked against a double entry system for errors.

Hence the reason, I was looking for a solution that copies each row as amended/typed or one that copies the block of data just completed, activated by a double-click.

Another way of looking at it would be to copy the range of cells above the position of the cursor, appertaining to the latest date and activated by a double-click.

I noticed that you have tidied up my other code which I always grateful for this help plus you have moved them to a Module. Whilst I have checked the SortColumns macro, it now won't sort the header, so that the header appears at the bottom of the list of data after running the macro.

Incidentally, I also have macros of the same name "SortColumns" and "Fill_Blanks" in other worksheets but customised to suit the relevent worksheet in the main workbook.

Could you explain me to me if this is likely to cause problems and the benefits of moving the other macros to a module.

Thanks for your help ...DGT

rbrhodes
08-15-2009, 05:14 PM
Hi dgt,

I moved the sort macro to a module because I didn't know it was sheet specific. My normal practice would be to write one sub in a module and either customize it for the different sheets (in the sub) or build it to accept arguments for the different sheets. I suggest you move it back to it's sheet.

As for the Header problem, look in the example below and you'll see 'Header:=xlGuess' change that to 'Header:=xlYes' and that should solve the problem.


Sub SortColumns()
With Sheets("Input2").Columns("A:F")
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _
Key2:=.Cells(2, 2), Order2:=xlAscending, _
Key3:=.Cells(2, 3), Order3:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
End With

Calculate
End Sub


For copying only from the cursor position Change the sub as below, adding the one line that is marked. This will copy the date cell that is doubleclicked in and any data above it (for that date).



<SNIP>

'Is somewhere in range
Else
LastRow = tRow + (WeekRows - (tRow Mod WeekRows))
FirstRow = LastRow - (WeekRows - 1)

'//ADD
LastRow = tRow
'//End

Range(Cells(FirstRow, tCol).Address, Cells(LastRow, tCol + 6).Address).Copy DestSht.Cells(DestRow, 1)
End If
Else
'Not date
msg = MsgBox("Please doubleclick in a date cell!", vbExclamation, "Date cells only.")
End If

<SNIP>

dgt
08-16-2009, 04:05 AM
Hi rbrhodes

Thanks for the latest update but still having problems. When I initially ran the code with some data for this week i.e. 15/08/09 it inserted the new data after the last row of 01/08/09 and before the first row of 08/08/09 (Input2). However, this was in the early hours of this morning, so may have been half asleep!

Feeling a bit fresher this morning, I re-arranged the Input3 worksheet, so that the new data that needs copying to Input2 will always start from A1:G1 which I assume will do away with the need to customise the 300 rows that we originally worked on.

Likewise this data will always follow on from the last entry of the previous week in Input2. So if the double-click is triggered in Input3 it can copy all data above it in Input3 (A:G) to the row below the last entry of the previous week (Input2). That way it does'nt matter how many new rows there are and the new data is simply over written until completed.

Hope this makes sense?

The other problem that I'm having is that when you double-click the date cell, it is left as in open for editing, rather than just with the cursor positioned at that cell.

I have attached an updated test workbook without the new data being transferred from Input3 to Input2.

Thanks for all your efforts ...DGT

rbrhodes
08-16-2009, 07:57 PM
Try this...


It will kill all old data beyond current paste unless you delete the lines in the code to that tell it to. They're marked with comments.

It will also copy the 'trailing' subtotal at the end if you click on the last populated date cell but choke if you click on the blank cell below the last date cell. I could change that I suppose...

dgt
08-17-2009, 02:42 AM
Hi rbrhodes

Just done some quick testing on various rows and it seems to be working fine, going to implement it into the main workbook this afternoon.



It will also copy the 'trailing' subtotal at the end if you click on the last populated date cell but choke if you click on the blank cell below the last date cell. I could change that I suppose...


Whilst I can live with that small problem, it would help if it could be changed for when someone else is using the workbook.

For the same reason, is there any way of resolving the minor problem with the "double-clicked" cell, which remains in an F2 editing state after being clicked.

I tried adding

Application.CutCopyMode = False

before the end sub but that did not cure it.

Thanks again ...DGT

rbrhodes
08-17-2009, 11:26 AM
Hi,

This code will fire when any cell is clicked and will find the closest date cell in Col A to work with. That should solve the first bug.


Secondly:

As I do know you _don't_ want to be left in edit mode after the DblClick I put in the appropriate command 'Cancel = true'.

As this will disbale the DblClick edit mode function, the sub asks if you want to run the macro or edit the cell. There are two lines in the sub -clearly commented - that perform the message box action.

As I always use <F2> so I would personally find the msgbox a pain! and I would kill it by deleteing the commented lines.

...we're done...



Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cVal
Dim msg As Long
Dim tCol As Long
Dim gRow As Long
Dim tRow As Long
Dim DestRow As Long
Dim LastRow As Long
Dim DestSht As Worksheet

'//Lines to delete to kill message and answer

'Ask user: Run Sub or edit cell?
msg = MsgBox("Run Macro?", 36, "Macro or Edit cell?")

'If not 'Yes" (6) then bail
If msg <> 6 Then GoTo endo
'//End delete lines


'Run sub without edit mode
Cancel = True
'Where to put
Set DestSht = Sheets("Input2")
'Get Row we're in
tRow = Target.Row

'Get col we're in
If Target.Column = 1 Then
'Get cell value
cVal = Target
Else
'Check if subtotal hanging out...
If Cells(tRow, 1) = "" Then
gRow = Cells(tRow, 1).End(xlUp).Row
cVal = Cells(gRow, 1)
Else
cVal = Cells(tRow, 1)
End If
End If

'Check is date
If IsDate(cVal) Then
With DestSht
'Convert
cVal = CDate(cVal)
'Is date. Get last row of destination sheet
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'Allow not found error
On Error Resume Next
'Get dest row
DestRow = .Range("A1:A" & LastRow).Find(What:=cVal, After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
'Reset
Err = 0
On Error GoTo 0
'Check if found
If DestRow = 0 Then
'Not found. Append data
DestRow = LastRow + 1
'//Delete lines to leave old data beyond paste
Else
'Delete old
.Range(Cells(DestRow, 1).Address, Cells(LastRow, 7).Address).ClearContents
'//End remove lines

End If
'Copy/Paste
Range("A1:G" & tRow).Copy .Cells(DestRow, 1)
End With
Else
'Not date
msg = MsgBox("Please doubleclick in a date cell!", vbExclamation, "Date cells only.")
End If
endo:
'Cleanup
Set DestSht = Nothing
End Sub

dgt
08-17-2009, 06:08 PM
Hi rbrhodes

Thanks for your continued efforts.

I'm having a knee operation later today, so will be unable to implement your latest code until later in the week.

Regards ...DGT

rbrhodes
08-17-2009, 06:55 PM
Hi dgt,

Hope it goes well... the knee ( and the code!)

Dusty Rhodes