PDA

View Full Version : Am I using .Find correctly?



adventagious
12-12-2008, 04:34 PM
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.


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

mdmackillop
12-12-2008, 05:47 PM
Can you post your workbook? Use Manage Attachments in the Go Advanced reply section.

BTW
Instead of

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

'try
If atpVal = "Select" Then
Selection.offset(,-4).resize(,5).Font.ColorIndex = 1

adventagious
12-15-2008, 11:13 AM
Workbook attached.

Thanks for the condensed *offset* code. I knew there was a way to do that.

The code you're looking for is behind the sheet *Excel-1*. The other pertinent sheet is QuotaTracker.

n8Mills
12-15-2008, 07:32 PM
It would help if you could narrow down the example, it's a lot of work for somebody figure out this much code.

Anyway, the problem might be that in the .Find the first thing you need to have is "What:="

So, Set deptMatch = .Find(deptCode, LookIn:=xlValues, Lookat:=xlPart) might need to be Set deptMatch = .Find(What:=deptCode, LookIn:=xlValues, Lookat:=xlPart)

adventagious
12-16-2008, 10:42 AM
N8Mills,

I tried adding What:=deptCode, but that did not cause this ElseIf to work:


ElseIf deptMatch > deptMatch.Offset(0, -1) Then
Response = MsgBox("& deptCode has exceeded their quotas for this class series.",_
vbExclamation, "Exceeded Quota Notice")
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 3


I tightened up the code per what mdmackillop pointed out and expanded the commented explanation of
what the validation check is supposed to accomplish. I'm pasting it in below. I will attach a new version
of the workbook as well. I'm still looking for a solution to why that ElseIf isn't working or for a more
accurate way to code this. Thanks.


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
'-------------------------------------------------------
'Selection.Offset(, -4).Resize(, 5) equals the following:
' Selection
' ActiveCell.Offset(0, -1)...
' ActiveCell.Offset(0, -2)...
' ActiveCell.Offset(0, -3)...
' ActiveCell.Offset(0, -4)...
'This will apply the changes to the selected cell and the four to the left.
'--------------------------------------------------------
If atpVal = "Select" Then
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 36

'Validation check number 2
ElseIf atpVal = "Yes" Then

'-------------------------------------------------------------------------------------
'The following will match the actual Department Code value (i.e., 100PI) in the
'deptCode range with the ATP status cell in the qTracker range on the QuotaTracker
'worksheet. If the value in the ATP status cell in the qTracker range in the QuotaTracker
'worksheet is <= the ATP quota control number located one cell to its left, the
'registration cell range in this worksheet will turn lime green.
'If the value in the ATP status cell 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(What:=deptCode, LookIn:=xlValues, Lookat:=xlPart)
If Not deptMatch Is Nothing Then

If deptMatch <= deptMatch.Offset(0, -1) Then
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).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.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).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.Offset(, -4).Resize(, 5).Font.ColorIndex = 3
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 36

'End If for all three validation checks
End If

'End For
Next atpVal

'End If Not Intersect
End If
End Sub

n8Mills
12-16-2008, 12:10 PM
Sorry, I didn't notice that "deptMatch" was a Range, I thought it was a String.

I've never used .Find for Ranges, but when I trace it back it might not be your problem as your code causes it to find Range("W13") in the quota tracker, which is the first empty.

Your code:Set deptCode = ActiveCell.Range("Excel1_AttendeeDept") produces the address "$Q$37:$Q$267", which I don't think is what you want. It looks like you want to get the cell from column "H" but using .Offset didn't work for me (I think because it assigned a value, not a Range).

Am I off-base? I just want to make sure I'm going down the right path, here.

adventagious
12-16-2008, 12:51 PM
I've never used .Find for Ranges, but when I trace it back it might not be your problem as your code causes it to find Range("W13") in the quota tracker, which is the first empty.

That confuses me.

The .Find is clearly not set up properly then. What I was trying to get it to do is look for the current value of deptCode (i.e., 100PI) within the range of C13:AF13 on the QuotaTracker sheet (the qTracker range). Then when it finds it within part (using xlPart) of one of the formulas within that range (in the case of 100PI, this would be D13), then have it compare the value of that cell (not the formula or its address) with the cell to its left (in the case of 100PI, D12).


Your code:Set deptCode = ActiveCell.Range("Excel1_AttendeeDept") produces the address "$Q$37:$Q$267", which I don't think is what you want. It looks like you want to get the cell from column "H" but using.

Correct. I don't understand how it would be pulling in that address. "Excel1_AttendeeDept" is a named range. Within the Names window, it refers to ='Excel-1'!$H$11:$H$241. Looking at that now, I'm realizing that setting it to equal the active cell of that range is not correct. Perhaps the current row of that range which would equal an offset of -2 from the actual activecell location in column J?


Offset didn't work for me (I think because it assigned a value, not a Range).

What is the proper syntax in this case of measuring the value of that cell to the one to its left?


Am I off-base? I just want to make sure I'm going down the right path, here.

It looks like it. Your analysis is showing me that what I'm wanting and expecting this code to accomplish is not working. Any other recommendations you can make based on what else I've shared above, I'd greatly appreciate.

n8Mills
12-16-2008, 05:11 PM
Perhaps the current row of that range which would equal an offset of -2 from the actual activecell location in column J?
That's what I would do. So this will get the value of that cell:
Dim deptCode As String
deptCode = ActiveCell.Offset(, -2)Then, further down, you can look up that value in the QuotaTracker sheet.
With Worksheets("QuotaTracker").Cells.Find(What:=deptCode, LookIn:=xlValues, Lookat:=xlPart)

If .Row > 11 Then

If .Value <= .Offset(0, -1) Then
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 4

ElseIf .Value > .Offset(0, -1) Then
Response = MsgBox("& deptCode has exceeded their quotas for this class series.", vbExclamation, "Exceeded Quota Notice")
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 3

'End Quota ATP check
End If

'End If Not deptMatch
End If

'End reference to qTracker
End WithAnd I would just lose the "deptMatch" entirely.

See attached. I put ".Row > 11" because all your values start at Row 12, if Excel can't find a value it will error out so you'd need to build in some error checking for when people try to choose "Yes" or "No" without first choosing a department.

adventagious
12-17-2008, 10:40 AM
This is excellent. I think I'm almost there.

However, based on how it is currently written, I'm getting an exceeded quota response for 100PI before it is exceeded when (QuotaTracker) D:13 = D:12.

And I'm also getting no exceeded quota response for 105 when (QuotaTracker) F:13 > F:12.

I'm guessing that means it is finding the value in the headers in row 12 on that sheet.

I either need it to find the "deptCode" within the formula in row 13 or I need to use offset to compare the two cells below the found reference on row 12 (i.e., if 100PI, then D:13 and D:12).

Assuming I'm right on that, I've tried playing around with the code to achieve that but no success.

I've also tried changing:

If .Row > 11 Then

to

If .Row > 12 Then

In order to make it find the deptCode within the formula, but that gives me no feedback on changes made to the *ATP?* validation cell. So I'm guessing that it can't find the deptCode within the formula part? Stumped on what the next step is.

n8Mills
12-17-2008, 01:06 PM
I'm guessing that you inherited this tool from somebody because this stuff is more sophisticated than my experience. Anyway, I think we can get it working with a couple more changes.

Now that I think about it you can change it to "If .Row = 12 Then" because you're only searching the header.

So, when you run the ".Find" it returns the first hit on the sheet, i.e. the value closest to the top-left, and your offset is pointing to the column to the left, not the right

The biggest thing, though,is that we've been comparing the headers only, not the actual body of data. I can't see how you'd get a cell address from the above data, so I put the Sheet name "Excel-1" in column "A" so I could search for the active sheet name and get the row with this: cellCol = Sheets("QuotaTracker").Cells.Find( _
What:=deptCode, LookIn:=xlValues, Lookat:=xlPart).Column
cellRow = Sheets("QuotaTracker").Cells.Find( _
What:=ActiveSheet.Name, LookIn:=xlValues, Lookat:=xlPart).Row

With Sheets("QuotaTracker").Cells(cellRow, cellCol)
If cellRow > 12 Then

If .Value >= .Offset(, 1) Then
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 4

ElseIf .Value < .Offset(, 1) Then
Response = MsgBox("& deptCode has exceeded their quotas" _
& "for this class series.", vbExclamation, "Exceeded Quota Notice")
Selection.Offset(, -4).Resize(, 5).Font.ColorIndex = 1
Selection.Offset(, -4).Resize(, 5).Interior.ColorIndex = 3

'End Quota ATP check
End If

'End If Not deptMatch
End IfSo, see attached. It still needs for you to build in some error trapping when people try to choose "Yes" without first selecting a department. To get it work other other sheets you need to fill column "A" with the sheet names.

adventagious
12-17-2008, 01:12 PM
Ok. I believe I've solved it.

Instead of heading both columns with the dept code in the QuotaTracker worksheet, I listed it only in the Actual column.
Then I offset it down one row and compared that cell to the cell to its left. For each workbook, I can offset down to the respective row.
I also worked in the error check to ensure that a dept code has been selected before running the ATP validation quota check.
Also, if someone returns the ATP? cell back to Select after having selected a dept code (if they decide to back out of the registration), it will return the dept code cell back to the "Select" default.Let me know if I'm missing anything here, need any addition error checks, or if there is a better way to structure this.

I'll upload the latest workbook rendition.

adventagious
12-17-2008, 01:40 PM
That is funny. You must have posted that just before I posted last.


I can't see how you'd get a cell address from the above data, so I put the Sheet name "Excel-1" in column "A" so I could search for the active sheet name and get the row with this:
cellCol = Sheets("QuotaTracker").Cells.Find( _
What:=deptCode, LookIn:=xlValues, Lookat:=xlPart).Column
cellRow = Sheets("QuotaTracker").Cells.Find( _
What:=ActiveSheet.Name, LookIn:=xlValues, Lookat:=xlPart).Row

With Sheets("QuotaTracker").Cells(cellRow, cellCol)
This is cool, using *ActiveSheet.Name*. Now I know another way to find a given location on another worksheet.

Would you mind still taking a look at the most recent file I uploaded to see if you notice any problems? I really appreciate all your help on this N8Mills. I was pulling my hair out yesterday when I left work.

The only thing I actually inherited was the idea and a much different workbook with no code and a few formulas. Managing what the registration process was orginally was becoming a major headache for a co-worker.

I took it from him and wrote the code from scratch after reading thru a bunch of forums and help sites. I guess I'm just a glutton. You'd think I'd start with a much easier project. I knew how the process needed to work and therefore what I wanted the code to do -- that I needed it work on multiple sheets, and that I didn't want to write a ton of respective code on each sheet. I'd originally tried to set up all the classes on one sheet using arrays but was way too complex. The feedback from the process pointed me toward how the solution needed to be structured.

Again, thanks very much for the help.

n8Mills
12-17-2008, 02:32 PM
Looks like you've got all you need with the Activesheet.Name twist, I think it will work out fine. I'm glad to see that you got it mostly figured out on your own.

BTW, call me n8!

adventagious
12-17-2008, 05:05 PM
BTW, call me n8!
Will do. Thanks again n8.

There is some automated shuffling of registration data based on that formatting validation that I'll work on next, but that may have to wait till after the holidays.

Merry Christmas n8.