VBA Help for Selection Change

[Timmer7]

Hi Everyone,
I would like to set up my sheet this way: in column A a date & time; in column B a list, i.e., "15 Minute Break," "911 Call," "BHS Assist," etc, and the other columns along the same row would fill in dependent on the event chosen in column B. I originally set one part of it in a module but I would like to have it as a Selection Change for all the above details. For Example: in column B, 15 Minute Break is chosen, the date & time should automatically show up in column A, with the word "~Break~" filling in on the same row but in another column....
Whatever help I can get will be much appreciated!

Windows 7; Excel 2010....


If ActiveCell = "15 Minute Break" Then
ActiveCell.Offset(0, 3).Value = "15 Minute Break"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "30 Minute Lunch" Then
ActiveCell.Offset(0, 3).Value = "30 Minute Lunch"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "911 Call" Then
ActiveCell.Offset(0, 3).Value = "Type of problem…."
ActiveCell.Offset(0, 4).Value = "Have they called 911 or are you referring them to call 911…"
ElseIf ActiveCell = "911_Paramedics" Then
ActiveCell.Offset(0, 3).Value = "From Suite number or deparment…"
ActiveCell.Offset(0, 4).Value = "If known, determine the type of distress or problem….."
ElseIf ActiveCell = "Badging/Denise" Then
ActiveCell.Offset(0, 3).Value = "Exchge/New/Request?"
ActiveCell.Offset(0, 4).Value = "If Denise is not here, did you help them by giving them the appropriate form to fill out and/or telling them her hours of operations on Tues & Thurs"
ElseIf ActiveCell = "BHS Assist" Then
ActiveCell.Offset(0, 3).Value = "For Medicate/State Specific Reason?"
ActiveCell.Offset(0, 4).Value = "If known, level 1 or 2..what room number?"
ElseIf ActiveCell = "BHS Patient Escort" Then
ActiveCell.Offset(0, 3).Value = "From BHS to >"
ActiveCell.Offset(0, 4).Value = "Name of Destination here…"
ElseIf ActiveCell = "Caller" Then
ActiveCell.Offset(0, 3).Value = "General, not associated with other events"
ActiveCell.Offset(0, 4).Value = "Notes, if any, to jotted down for the nature of the call; once the nature of the event is known, enter the event in column B in a new row…"
ElseIf ActiveCell = "Cash Escort Café" Then
ActiveCell.Offset(0, 3) = "Location From and To"
ActiveCell.Offset(0, 4).Value = ""
ElseIf ActiveCell = "Cash Escort Foundation" Then
ActiveCell.Offset(0, 3).Value = "Location From/To"
ActiveCell.Offset(0, 4).Value = "Special detail from 505 building, SJMP, and St Joseph Hospital finance"
ElseIf ActiveCell = "Code Blue" Then
ActiveCell.Offset(0, 3).Value = "Location/Room #"
ActiveCell.Offset(0, 4).Value = "Officer should be sent up for crowd control problems, if any…"
ElseIf ActiveCell = "Code Gray" Then
ActiveCell.Offset(0, 3).Value = "Room/Section/Area"
ActiveCell.Offset(0, 4).Value = "After original Code Gray event, all other events in relation to this should fall under Status or other type of events"
ElseIf ActiveCell = "Code Pink" Then
ActiveCell.Offset(0, 3).Value = "Baby / Tag? Is it an Exit or Tamper Alarm"
ActiveCell.Offset(0, 4).Value = "Check Hugs computer for a location of last exciter"
ElseIf ActiveCell = "Code Red" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "Device #....smoke or flame detector…was the fire department called off? Yes or No"
ElseIf ActiveCell = "Code White" Then
ActiveCell.Offset(0, 3).Value = "Location/Room #"
ActiveCell.Offset(0, 4).Value = "Officer should be sent up for crowd control problems, if any…"
ElseIf ActiveCell = "Delivery Gate" Then
ActiveCell.Offset(0, 3).Value = "Company Name"
ActiveCell.Offset(0, 4).Value = "Granted Access to Loading Dock"
ElseIf ActiveCell = "Disorderly Patient" Then
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = ""
ElseIf ActiveCell = "Disorderly Person" Then
ActiveCell.Offset(0, 3).Value = "Building/Room, Etc"
ActiveCell.Offset(0, 4).Value = "After original Disorderly Person event, all other events in relation to this should fall under Status or other type of events"
ElseIf ActiveCell = "Elevator Trouble" Then
ActiveCell.Offset(0, 3).Value = "Telephone/Persons Stuck"
ActiveCell.Offset(0, 4).Value = "if unknown location, correspond Elevator number with map in the control center…"
ElseIf ActiveCell = "ER Patient Escort" Then
ActiveCell.Offset(0, 3).Value = "From ER Room # to >"
ActiveCell.Offset(0, 4).Value = "Name of Location"
ElseIf ActiveCell = "Fire System Test" Then
ActiveCell.Offset(0, 3).Value = "For what facility?"
ActiveCell.Offset(0, 4).Value = ""
ElseIf ActiveCell = "Graffiti" Then
ActiveCell.Offset(0, 3).Value = "What Area or Location?"
ActiveCell.Offset(0, 4).Value = "A report should be generated if it could not be sufficiently removed or specify who cleaned it up…"
ElseIf ActiveCell = "Henry Brothers Issue" Then
ActiveCell.Offset(0, 3).Value = "Door/Reader #"
ActiveCell.Offset(0, 4).Value = "this was called into HBE for a work order; if it was referred back to SJH, specify why here…."
ElseIf ActiveCell = "House Supervisor" Then
ActiveCell.Offset(0, 3).Value = "Problem/Concern"
ActiveCell.Offset(0, 4).Value = ""
ElseIf ActiveCell = "Hugs Comp Down" Then
ActiveCell.Offset(0, 3).Value = "Which One?"
ActiveCell.Offset(0, 4).Value = ""
ElseIf ActiveCell = "Hugs System" Then
ActiveCell.Offset(0, 3).Value = "Discharge/Loose Tag?"
ActiveCell.Offset(0, 4).Value = ""
ElseIf ActiveCell = "Jumpstart" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "who handled the call, either Security or Minuteman?"
ElseIf ActiveCell = "Jumpstart Charger" Then
ActiveCell.Offset(0, 3).Value = "Minuteman Employee"
ActiveCell.Offset(0, 4).Value = "specify whether they are taking the charger out or bringing it back in…"
ElseIf ActiveCell = "Key Assist/Unlock" Then
ActiveCell.Offset(0, 3).Value = "Type of Office/Room"
ActiveCell.Offset(0, 4).Value = "specify whether they are taking the charger out or bringing it back in…"
ElseIf ActiveCell = "Loud Noise" Then
ActiveCell.Offset(0, 3).Value = "Where? Who?"
ActiveCell.Offset(0, 4).Value = "specify whether they are taking the charger out or bringing it back in…"
ElseIf ActiveCell = "Mail Delivery" Then
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Medicate Patient" Then
ActiveCell.Offset(0, 3) = "Area/Location"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Minuteman Related" Then
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Morgue Access" Then
ActiveCell.Offset(0, 3).Value = "Granted"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Mortuary Escort" Then
ActiveCell.Offset(0, 3).Value = "Patient's Name and MM # here"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Officer Recall" Then
ActiveCell.Offset(0, 3).Value = "For Shift Coverage/Give Officer name in Dispo cell"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Patrol Check" Then
ActiveCell.Offset(0, 3) = "Building or Location"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Pkg Enforcement" Then
ActiveCell.Offset(0, 3).Value = "Location "
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Power Loss" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Radio Check Offsite" Then
ActiveCell.Offset(0, 3).Value = "Check in from offsite property…"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Radio/Pager Check" Then
ActiveCell.Offset(0, 3).Value = "To All Officers"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Reader and/or Door problems" Then
ActiveCell.Offset(0.3).Value = "Door or Reader number?"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Resource Center" Then
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Restricted Patient Information/Request" Then
ActiveCell.Offset(0.3).Value = "Patient Name/Room #"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Safety Checklist" Then
ActiveCell.Offset(0, 3).Value = "Room/Section/Area"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Sec Sup Request" Then
ActiveCell.Offset(0, 3).Value = "Type of Request"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "So Lobby Card Only" Then
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "So Lobby Unlock Mode" Then
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Status" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Student Badge Return" Then
ActiveCell.Offset(0, 3).Value = "School or University…"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Transport" Then
ActiveCell.Offset(0, 3).Value = "example: SJMP to Sister Elizabeth…in this cell"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Unknown Trouble" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Visitor Accident" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Visitor Control" Then
ActiveCell.Offset(0, 3).Value = "Name of Pat/Room #"
ActiveCell.Offset(0, 4).Value = "~Break~"
ElseIf ActiveCell = "Water Flow" Then
ActiveCell.Offset(0, 3).Value = "Area/Location"
ActiveCell.Offset(0, 4).Value = "~Break~"

End If

 

[CharlesChuckieCharles]

is Column B based on a list ( a data validation List ) ?

if so you should put the other entries against the column b Key

Then is just a couple of look ups in the vba macro and calling that for the worksheet_Change event

 

[Timmer7]

yes, I have a data validation list for it....

 

[Timmer7]

Are you able to give me an example of the look ups you're talking about?
Thanks,

 

[CharlesChuckieCharles]

There are several parts

Work sheet change event rund everytime any cell is changed in a given sheet
Assumptions
I've coded you column B depth as 10,000 rows : EDIT as required
I've decided that the data validation source list is Z1 to the last in the list : EDIT as required

Change you lookup area so that

ElseIf ActiveCell = "911 Call" Then
ActiveCell.Offset(0, 3).Value = "Type of problem…."
ActiveCell.Offset(0, 4).Value = "Have they called 911 or are you referring them to call 911…"

"911 Call" which is your Data validation source list

is now

Z1 AA1 AB1
"911 Call" "Type of problem…." "Have they called 911 or are you referring them to call 911…"

the lookups will use "911 Call" as the key and return "Type of problem…." using column 2 to offset 3 (column E) etc

and return "Have they called 911 or are you referring them to call 911…" using column 3 to offset 4 (column f) etc


also shoves Date time into column A

This has the benefit of being data driven which means when adding new status code entries there are no code changes required

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
If Intersect(Target, Range("B1:B10000")) = Nothing Then
  Exit Sub
Else
    Set MyRange = Range("Z1:Z" & Cells(Rows.Count, "Z").emd(xlUp).Row)
    Target.Offset(0, -1).Value = Format(Now(), "DD-MMM-YYYY HH:MM:SS")
    Target.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 2, False)
    Target.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 3, False)
End If
End Sub

 

[CharlesChuckieCharles]

Amendment

also this goes in the WORKSHEET MODULE of the sheet which as the B column of Data validation entries


Use this code ( schoolboy errors )

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
If Intersect(Target, Range("B1:B9999")) Is Nothing Then
  Exit Sub
Else
    Application.EnableEvents = False
    Set MyRange = Range("Z1:Z" & Cells(Rows.Count, "Z").End(xlUp).Row)
    Target.Offset(0, -1).Value = Format(Now(), "DD-MMM-YYYY HH:MM:SS")
    Target.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 2, False)
    Target.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 3, False)
    Application.EnableEvents = True

End If
End Sub

 

[Timmer7]

Thanks Charles for the detailed response for this; I like the way it can be data driven. I placed the data in the columns Z; AA; AB as was suggested but I'm getting an error when choosing from the data validation list in column B; it's bringing up the date & time okay, then an error message comes up; sorry for not seeing what is happening. Below is what the error message said...


runtime error 1004
unable to get the Vlookup property of the worksheetfunction class

 

[CharlesChuckieCharles]

Appologies

This line
Set MyRange = Range("Z1:Z" & Cells(Rows.Count, "Z").End(xlUp).Row)

should be replaced by this line
Set MyRange = ActiveSheet.Range("Z1:AB" & Cells(Rows.Count, "Z").End(xlUp).Row)

Note Z1:Z changed to Z1:AB tch!


A word about Application.EnableEvents = True

The subroutine is the Private Sub Worksheet_Change EVENT one of many in the worksheet

at the start of the sub it does

Application.EnableEvents = False

which disables ALL events from triggering

Thats because the following lines would normally trigger the same event that they are running in!! ( ie you're changing the worksheet)

Target.Offset(0, -1).Value = Format(Now(), "DD-MMM-YYYY HH:MM:SS")
Target.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 2, False)
Target.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 3, False)


IF you GET an ERROR after Application.EnableEvents = False then effectively you've turned off all the events and it hasn't passed through the enable Application.EnableEvents = True

use Application.EnableEvents = True in the immediate window to turn they back on

Or close and reopen your workbook

 

[Timmer7]

Mr Charles... sorry to get back with this topic as late as I have and thanks again for your help with this code; in the code below I added an adjacent column for other data needed but the last thing I would like to do is to lock columns A-C just after the columns are filled with the V-Lookup in the active row. Can I add something at the end of the change event to do this with?
Below is what I have thus far:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
If Intersect(Target, Range("B1:B9999")) Is Nothing Then

Else
    Application.EnableEvents = False
    Set MyRange = Range("Z1:AB" & Cells(Rows.Count, "Z").End(xlUp).Row)
    Target.Offset(0, -1).Value = Format(Now(), "DD-MMM-YYYY HH:MM:SS")
    Target.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 2, False)
    Target.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 3, False)
    Application.EnableEvents = True
End If
If Intersect(Target, Range("C1:C9999")) Is Nothing Then
  Exit Sub
Else
    Application.EnableEvents = False
    Set MyRange = Range("AD1:AF" & Cells(Rows.Count, "AD").End(xlUp).Row)
    Target.Offset(0, -2).Value = Format(Now(), "DD-MMM-YYYY HH:MM:SS")
    Target.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 2, False)
    Target.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, MyRange, 3, False)
    Application.EnableEvents = True
End If
End Sub

 

[CharlesChuckieCharles]

Just add

to Unfreeze
Range("D1").Select
ActiveWindow.FreezePanes = False



to Freeze
Range("D1").Select
ActiveWindow.FreezePanes = True

add the end