PDA

View Full Version : Pass Sheet Range to a SelectionChange Event



stuartgb100
05-08-2015, 11:07 AM
Range K50 is a cell I need to keep track of.

User can insert or delete rows, so I need to track this dynamically.


Can I put a reference to K50 in J3 which will be updated dynamically, such that when SelectionChange Event code fires, I can reference the contents of J3?

Perhaps the Event code fires before J3 is updated ?

Thanks,
Stuart.

mperrah
05-08-2015, 01:16 PM
there are several ways to manage this event.
how is the worksheet data arranged?
is there a column that has a certain number of rows containing data?
if so, we can trigger an alert when the rows.count value changes

put these on the sheet code module

Public lOldRowCount As Long

Private Sub Workbook_Open()
ActiveSheet.UsedRange
lOldRowCount = ActiveSheet.UsedRange.Rows.Count
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lNewRowCount As Long

ActiveSheet.UsedRange
lNewRowCount = ActiveSheet.UsedRange.Rows.Count

If lOldRowCount = lNewRowCount Then
ElseIf lOldRowCount > lNewRowCount Then
MsgBox ("Row Deleted")
lOldRowCount = lNewRowCount
ElseIf lOldRowCount < lNewRowCount Then
MsgBox ("Row Inserted")
lOldRowCount = lNewRowCount
End If

End Sub
works after saving the opened document

Paul_Hossler
05-08-2015, 01:28 PM
Big question is Why are you tracking it and what do you need to do?


You said Worksheet_SelectionChange. Are you sure you didn't want Worksheet_Change event??


In any event, I would assign a Name to K50 and the Name's location will be updated as you add or delete rows, etc.


So naming K50 in the beginning to be "Tracking" the 2 event handlers (which ever one you want) will use the name to find the value




Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Value of the Magic Cell is " & [Tracking].Value
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "Value of the Magic Cell is " & [Tracking].Value
End Sub

stuartgb100
05-08-2015, 03:03 PM
mperrah & Paul,

Thanks for the replies.

mperrah,
I need a solution that passes control back to the user with everything updated, without having to first close and then reopen the workbook.

Paul,
I'm checking user's date in column k.
If there's a red fill cell in 'K' then user has decided their data is not complete.
I need to find when user has removed the last red cell.
Worksheet_Change event will not pick up a fill change.
If there is no red cill in the 'K' range, then I'll put a formula in the appropriate K cell.

So if user's data is in rows 6 to 49 (with their totals in the 'K' cells for each row),
I will only allow a total for K6:K49 in K50, when there is no red cell in K6:k49.

I have SelectionChange code which works well, until there is only one red cell left !

Each time this code runs, it has to find the TotalCell (initially K50).
This is not a static range, since user can insert or delete rows between row 6 and row 50.

I thought if I could 'pass' the current K50 to the Selection_Change event, then I could call the range, rather than have to find it first, each time.

Regards both, and thanks.

p45cal
05-08-2015, 03:40 PM
Perhaps naming cell K50, say "TotalCell", then you're able to refer to it in a macro as range("TotalCell")

mperrah
05-08-2015, 03:42 PM
this can test for the interior of K50 to be red,
maybe this can be incorporated to the rest of your code?


Sub colorTest()
If Cells(50, 11).Interior.Color = 255 Then
MsgBox ("Cell color is red")
End If
End Sub

mperrah
05-08-2015, 03:45 PM
or something like this

Sub moreColorTest()
Dim x As Long
For x = 6 To 49
If Cells(x, 50).Interior.Color = 255 Then
MsgBox ("A cell has red")
End If
Next x
End Sub

mperrah
05-08-2015, 03:48 PM
or this

Sub moreColorTest()
dim lr as long
Dim x As Long
lr = cells(rows.count, 50).end(xlup).row
For x = 6 To lr
If Cells(x, 50).Interior.Color = 255 Then
MsgBox ("A cell has red")
End If
Next x
End Sub

SamT
05-10-2015, 01:50 PM
mperrah & Paul,

Thanks for the replies.

mperrah,
I need a solution that passes control back to the user with everything updated, without having to first close and then reopen the workbook.

Paul,
I'm checking user's date [data?] in column k.
If there's a red filled cell in 'K' then user has decided their data is not complete.
I need to find when user has removed the last red cell.
Worksheet_Change event will not pick up a fill change.
If there is no red cell in the 'K' range, then I'll put a formula in the appropriate K cell.

So if user's data is in rows 6 to 49 (with their totals in the 'K' cells for each row),
I will only allow a total for K6:K49 in K50, when there is no red cell in K6:k49.

I have SelectionChange code which works well, until there is only one red cell left !

Each time this code runs, it has to find the TotalCell (initially K50).
This is not a static range, since user can insert or delete rows between row 6 and row 50.

I thought if I could 'pass' the current K50 to the Selection_Change event, then I could call the range, rather than have to find it first, each time.

Regards both, and thanks.

Stuart, I used to be a regular here, but now a days I can only stop by once in a while.

IMO it is best to keep all Event subs limited to deciding which procedures to run. this lets you use the same event for different purposes. It does require a little bit more thought and coding, but not much.

All tasks need three codes
1) a line in the Event code If Condition Then Procedure
2) A Condition checking function
3) The Sub that completes the task

In your case the prerequisites are as P45cal said, naming Range"(K50") and Range ("K6"), perhaps "TotalCell" and "StartCell" respectively. Use names that make the most sense to you.

The condition Function can look like this

Function RedCheck() As Boolean
Const Red As Long = 255
Dim Cel As Range

RedCheck = True 'Condition functions alway return True if the Task is to be done

For Each Cel in Range("StartCell", "TotalCell")
If Cel.Interior.Color = Red Then
RedCheck = False 'Found red fill. Don't do the task
Exit Function
End If
End Function

The Task Procedure I will leave up to you, but for demonstration purposes I need a dummy sub

Sub InsertFormulaInTotalCell()
BlahBlahBlah
End Sub

You indicated that you wanted to use the Selection Change Event, so

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range(Rows(StartCell.Row), Rows(TotalCell.Row)) Is Nothing, Then Exit Sub

If RedCheck Then InsertFormulaInTotalCell
If BlueCheck Then DoSomeThingElse 'example of selecting multiple tasks with one event sub
If BeerCheck Then GoPartyAtTheBar
'These examples can be combined with
'If Intersect(Different ranges) then
'If Conditioncheck Then Task

End Sub


If you have to, you can name Range ("K50") with code before the User can insert,delete any rows.

stuartgb100
05-11-2015, 02:03 AM
Thanks Sam,

The advice is appreciated, and noted.
I will amend my Event Code accordingly - should be much clearer to follow !

Quote:
"If you have to, you can name Range ("K50") with code before the User can insert,delete any rows."

I would rather not have to do this, but if my current solution fails to be robust, that would be good to know.

Can you give me an example of the code to do that, please ?

Regards and thanks,
Stuart.

SamT
05-11-2015, 06:23 AM
Sub MakeRange()

ActiveWorkbook.Names.Add _
Name:="tempRange", _
RefersTo:="=Sheet1!$A$1:$D$3"

End Sub

Paul_Hossler
05-11-2015, 09:02 AM
@SamT -- Welcome back -- missed you. Try to drop I more often

@stuartgb100 -- the way I did it in my post #3 was strictly manual since I took it to be one time thing -- See screen shot

Select K50 (you can do any other single of multiple cells) and just enter the name

p45cal
05-11-2015, 01:24 PM
Sub MakeRange()

ActiveWorkbook.Names.Add _
Name:="tempRange", _
RefersTo:="=Sheet1!$A$1:$D$3"

End Subalso:
Sheets("Sheet1").range("A1:D3").Name = "tempRange"or
[Sheet1!A1:D3].name = "tempRange"

stuartgb100
05-11-2015, 02:01 PM
Thanks all.
Not just for the instruction as to the method, but equally important, examples to implement it.
Much appreciated. I have made notes, and WILL follow this up.

In the meantime my timescale to implement this routine and distribute to my co-workers diminishes alarmingly, so I will have to go with what I have.

I have prepped them as best I can:

make backups by copying and pasting current work the into a NEW workbook (no vba routines)
make these backups regularly
'tag' the new workbooks with a date etc., so it's easy to see the latest backup
etc., etc.

SamT,

if I have time before my deadline, I will post a new thread concerning good practice for the construct of code, and its placement.
Hoping to get answers giving a beginner's guide to first principles - hopefully something I can understand !

If this is documented here already, then apologies - I've not found it.

SamT - I hope you will contribute (I see your presence is valued)

Best Regards and thanks all,
Stuart.

SamT
05-11-2015, 08:01 PM
Here is the code from the ThisWorkbook Code page in my very own Personal.xls workbook. It has been over a decade in developing.

It can handle backups being moved from drive to drive and computor to computor; Backups getting corrupted by automatic backups of corrupted workbooks, (I still haven't recovered all my work lost in that incident.)


Option Explicit

Private Const BackUpDrive As String = "E:"
Private Const BackUpFolder As String = "MyPersonal"
Private Const BackUpName As String = "Personal.xls.Bak"



Private Sub Workbook_BeforeClose(Cancel As Boolean)
'I play with too much bad OP code not to have this.
RestoreApplication

End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
MakeCopyOfPersonal

End Sub



Sub RestoreApplication()
With Application
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub



Private Sub MakeCopyOfPersonal()
Dim TimeStamp As String 'provides unique by date-time name string

If Len(Dir(BackUpDrive & "\" & BackUpFolder, 16)) = 0 Then
MsgBox "Personal xls not backed up. Cannot find the Backup Folder"
Exit Sub
End If

TimeStamp = Left(CStr(CDbl(Now)), 10) & "_"
Me.SaveCopyAs (BackUpDrive & "\" & BackUpFolder & "\" _
& TimeStamp & BackUpName)

End Sub

stuartgb100
05-12-2015, 12:49 PM
The comprehensive backup procedure is very much appreciated.

Best Regards and thanks,
Stuart.