I dabbled in VBA several years ago, then had a job change. So this is the first thing I've build in some time.
I am building a workbook with the purpose of having training coordinators throughout the company, register their divisions employees for training. I am using validation pick lists for *Dept* and *ATP?* (annual training plan).
A separate sheet lists tracks the running total of training seats requested vs. the original number requested on their submitted plan.
When an *ATP?* value is selected (Yes or No) it runs a change macro. If Yes, it checks to see if the Dept code quotas for the class
is <= to the number requested. If >, it returns a msgbox notifying the submitter. Interior color and font combinations result based on
the ATP? selection as well.
The next step goal will be to build a macro to move those ranges of data based on these format conditions.
Everything is working fine except this ElseIf statement below the With qTracker line:
ElseIf deptMatch > deptMatch.Offset(0, -1) Then
It is not making the color change nor returning the message box. I'm guessing that I'm not understanding the .Find function correctly. Can someone point out where I went wrong? I'm posting this just before leaving for the weekend, so I will check first
thing Monday morning the 15th.
Thanks.
[vba]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim atpVal As Range
Dim qTracker As Range
Set qTracker = Worksheets("QuotaTracker").[QuotaTracker_Excel1]
Dim deptMatch As Range
Dim deptCode As Range
Set deptCode = ActiveCell.Range("Excel1_AttendeeDept")
If Not Intersect(Target, Range("Excel1_ATP?")) Is Nothing Then
For Each atpVal In Target
'Validation check number 1
If atpVal = "Select" Then
Selection.Font.ColorIndex = 1
ActiveCell.Offset(0, -1).Font.ColorIndex = 1
ActiveCell.Offset(0, -2).Font.ColorIndex = 1
ActiveCell.Offset(0, -3).Font.ColorIndex = 1
ActiveCell.Offset(0, -4).Font.ColorIndex = 1
Selection.Interior.ColorIndex = 36
ActiveCell.Offset(0, -1).Interior.ColorIndex = 36
ActiveCell.Offset(0, -2).Interior.ColorIndex = 36
ActiveCell.Offset(0, -3).Interior.ColorIndex = 36
ActiveCell.Offset(0, -4).Interior.ColorIndex = 36
'Validation check number 2
ElseIf atpVal = "Yes" Then
'The following will match the deptCode with the ATP status cell in the qTracker Range
'on the QuotaTracker worksheet
'If the value is <= the ATP quota control number, the registration cell range will turn lime green
'If the value exceeds the ATP quota control number, a msgbox will return an exceedence
'statement and turn the registration cell range red
With qTracker
Set deptMatch = .Find(deptCode, LookIn:=xlValues, Lookat:=xlPart)
If Not deptMatch Is Nothing Then
If deptMatch <= deptMatch.Offset(0, -1) Then
Selection.Font.ColorIndex = 1
ActiveCell.Offset(0, -1).Font.ColorIndex = 1
ActiveCell.Offset(0, -2).Font.ColorIndex = 1
ActiveCell.Offset(0, -3).Font.ColorIndex = 1
ActiveCell.Offset(0, -4).Font.ColorIndex = 1
Selection.Interior.ColorIndex = 4
ActiveCell.Offset(0, -1).Interior.ColorIndex = 4
ActiveCell.Offset(0, -2).Interior.ColorIndex = 4
ActiveCell.Offset(0, -3).Interior.ColorIndex = 4
ActiveCell.Offset(0, -4).Interior.ColorIndex = 4
ElseIf deptMatch > deptMatch.Offset(0, -1) Then
Response = MsgBox("& deptCode has exceeded their quotas for this class series.",_
vbExclamation, "Exceeded Quota Notice")
Selection.Font.ColorIndex = 1
ActiveCell.Offset(0, -1).Font.ColorIndex = 1
ActiveCell.Offset(0, -2).Font.ColorIndex = 1
ActiveCell.Offset(0, -3).Font.ColorIndex = 1
ActiveCell.Offset(0, -4).Font.ColorIndex = 1
Selection.Interior.ColorIndex = 3
ActiveCell.Offset(0, -1).Interior.ColorIndex = 3
ActiveCell.Offset(0, -2).Interior.ColorIndex = 3
ActiveCell.Offset(0, -3).Interior.ColorIndex = 3
ActiveCell.Offset(0, -4).Interior.ColorIndex = 3
'End Quota ATP check
End If
'End If Not deptMatch
End If
'End reference to qTracker
End With
'Validation check number 3
ElseIf atpVal = "No" Then
Selection.Font.ColorIndex = 3
ActiveCell.Offset(0, -1).Font.ColorIndex = 3
ActiveCell.Offset(0, -2).Font.ColorIndex = 3
ActiveCell.Offset(0, -3).Font.ColorIndex = 3
ActiveCell.Offset(0, -4).Font.ColorIndex = 3
Selection.Interior.ColorIndex = 36
ActiveCell.Offset(0, -1).Interior.ColorIndex = 36
ActiveCell.Offset(0, -2).Interior.ColorIndex = 36
ActiveCell.Offset(0, -3).Interior.ColorIndex = 36
ActiveCell.Offset(0, -4).Interior.ColorIndex = 36
'End If for all three validation checks
End If
'End For
Next atpVal
'End If Not Intersect
End If
End Sub
[/vba]