Problem with setting value in validated range

[Darren Hill]

Excel 2007

I'm having a problem with datavalidation in VBA.

I have a couple of cells (Ranges: "Stress_health" and "Stress_Composure")
which contain values in the wingdings font - so they value might be
"jjjjj", for instance.
So, to esnure these don't have to be typed in, I've created a range on
another sheet which contains the possible valid character values.
The complication is that sometimes the list exposed to the user changes,
so it's sometimes "List_Stress1", or "List_Stress2" or "List_Stress3"

So what the Sub below is supposed to do, is check the Stess_Health or
Stress_Composure box for which of the three lists is in use, then enter a
value from that list.

The Stress_Health and Stress_Composure boxes are merged cells, each 1 row
x 9 columns.

When this macro runs, it does nothing. The last row of the subroutine
"StressBoxes" should change the cell, but nothing happens. Even stranger,
if I happen to have any code after this point, it doesn't run but no error
is reported.
It doesn't seem to be related to the merged cells, since the same thing
happens if I unmerge the cells and use the commented out line.

I've been struggling with this off and on for about a week, and getting
nowhere. Any ideas?

Thanks,
Darren

Function GetValidationRange(ByVal CheckRange As Range) As String
Dim DataValid As String
DataValid = CheckRange.Validation.Formula1
DataValid = Replace(DataValid, "=", "")
GetValidationRange = DataValid
End Function

Sub StressBoxes(mySheet As Worksheet, bHealthOrComposure As Boolean,
myValue As Integer)

Dim StressText As String
Dim HealthOrComp As String
Dim rgRow As Integer
Dim ValidRange As String
Dim myRange As Range

Select Case bHealthOrComposure
Case True
HealthOrComp = "Stress_Health"
Case False
HealthOrComp = "Stress_Composure"
Case Else
' do nothing and end the procedure
Exit Sub
End Select

ValidRange = GetValidationRange(mySheet.Range(HealthOrComp))

Select Case myValue
Case 0
rgRow = 0
Case 1
rgRow = 1
Case 2, 3
rgRow = 2
Case 4, 5
rgRow = 3
End Select

Set myRange = Range(ValidRange)
StressText = myRange.Offset(rgRow, 0).Resize(1, 1).Value
'mySheet.Range(HealthOrComp).Value = StressText
mySheet.Range(HealthOrComp).MergeArea.Cells(1, 1).Value = StressText
End Sub

 

[Tim Williams]

How is "StressBoxes" being called? You're certain it's even running ?

Have you tried inserting some debug statements or stepping through the
procedure line-by-line to see what's happening ?

Tim

Excel 2007

I'm having a problem with datavalidation in VBA.

I have a couple of cells (Ranges: "Stress_health" and "Stress_Composure")
which contain values in the wingdings font - so they value might be
"jjjjj", for instance.
So, to esnure these don't have to be typed in, I've created a range on
another sheet which contains the possible valid character values.
The complication is that sometimes the list exposed to the user changes,
so it's sometimes "List_Stress1", or "List_Stress2" or "List_Stress3"

So what the Sub below is supposed to do, is check the Stess_Health or
Stress_Composure box for which of the three lists is in use, then enter a
value from that list.

The Stress_Health and Stress_Composure boxes are merged cells, each 1 row
x 9 columns.

When this macro runs, it does nothing. The last row of the subroutine
"StressBoxes" should change the cell, but nothing happens. Even stranger,
if I happen to have any code after this point, it doesn't run but no error
is reported.
It doesn't seem to be related to the merged cells, since the same thing
happens if I unmerge the cells and use the commented out line.

I've been struggling with this off and on for about a week, and getting
nowhere. Any ideas?

Thanks,
Darren

Function GetValidationRange(ByVal CheckRange As Range) As String
Dim DataValid As String
DataValid = CheckRange.Validation.Formula1
DataValid = Replace(DataValid, "=", "")
GetValidationRange = DataValid
End Function

Sub StressBoxes(mySheet As Worksheet, bHealthOrComposure As Boolean,
myValue As Integer)

Dim StressText As String
Dim HealthOrComp As String
Dim rgRow As Integer
Dim ValidRange As String
Dim myRange As Range

Select Case bHealthOrComposure
Case True
HealthOrComp = "Stress_Health"
Case False
HealthOrComp = "Stress_Composure"
Case Else
' do nothing and end the procedure
Exit Sub
End Select

ValidRange = GetValidationRange(mySheet.Range(HealthOrComp))

Select Case myValue
Case 0
rgRow = 0
Case 1
rgRow = 1
Case 2, 3
rgRow = 2
Case 4, 5
rgRow = 3
End Select

Set myRange = Range(ValidRange)
StressText = myRange.Offset(rgRow, 0).Resize(1, 1).Value
'mySheet.Range(HealthOrComp).Value = StressText
mySheet.Range(HealthOrComp).MergeArea.Cells(1, 1).Value = StressText
End Sub

 

[Darren Hill]

Stressboxes is called by the worksheet_change event, and I've stepped
through it line by line, watching it in increasing baflement as everything
seems to be working correctly up until that last line when nothing happens
(or, when I've put code after it, like a msgbox statement, see the macro
stop with no error before that new code is reached).

 

[Darren Hill]

Here's the code from the worksheet_change event:

If Not Application.Intersect(Target, Range("Skills")) Is Nothing Then
If blCancel Then Exit Sub
blCancel = True
SkillsChange Target.Worksheet
blCancel = False
End If

And here's the SkillsChange macro.

Sub SkillsChange(ws As Worksheet)
' need a macro to check if a skill changed, and update any values based on
it.
' doesn't need to use the "Target" variable, just recalculate the various
bits needed.

Dim CharName As String
Dim EnduranceRank As Integer
Dim ResolveRank As Integer

CharName = ws.Range("CharName").Value
' health stress
EnduranceRank = FindTraitValue(FindTraitRank("Endurance", CharName))
' composure stress
ResolveRank = FindTraitValue(FindTraitRank("Resolve", CharName))

Call StressBoxes(ws, True, EnduranceRank)
Call StressBoxes(ws, False, ResolveRank)

' initiative ratings


End Sub

The FindTraitValue and FindTraitRank functions work properly - I use them
in the worksheet for other things. Basically, they return a number from 0
to 5.