Is it possible to call Macros depending on cell Value?

[Barryj]

I have 2 Macros that provide the same outcome but calculate differently depending on the value in cell A1, these Macros are currently in different sheets.

What I want to do is if 36 is placed in cell A1 then call the first Macro, if 72 is placed in A1 then call the second Macro.

What do I need to do to acheive this, as in alter Macro's, and do I place them in the same sheet?

This is the first Macro that would run if 36 was in A1

[VBA]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Results As Range, Par As Range, PH As Range
Dim AH As Range, Score As Range
Dim Factor As Single
Dim i As Long, j As Long

Set Results = Cells(4, 9)
For i = 9 To 101 Step 2 'Amend to suit no. of rows
For j = 4 To 9 Step 5
Set Results = Union(Results, Cells(i, j))
Next j
Next i
If Not Intersect(Target, Results) Is Nothing Then
Enables False
Set Par = Range("A1")
Set Score = Target
Set AH = Target.Offset(, -1)
Set PH = Target.Offset(, -2)
Else
Exit Sub
End If

'Score equals par
If Score = Par Then GoTo NextScore

'Score is less than par
If Score < Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
GoTo NextScore
End If

'Score is greater than par
Select Case PH
Case Is <= 4
Factor = -0.1
Case Is <= 12
Factor = -0.2
Case Is <= 19
Factor = -0.3
Case Is < 27
Factor = -0.4
Case Else
Factor = -0.5
End Select
AH = AH + ((Score - Par) * Factor)
PH = CInt(AH + 0.1)

NextScore:
If Score.End(xlDown).Row = Cells.Rows.Count Then
Range("I9").Activate
ActiveWindow.ScrollRow = 7
Else
Score.Offset(2).Activate
End If
Enables True
End Sub
Function Enables(x As Boolean)
Application.EnableEvents = x
Application.ScreenUpdating = x
End Function
[/VBA]

This is the second Macro that would run if 72 was placed in A1

[VBA]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Results As Range, Par As Range, PH As Range
Dim AH As Range, Score As Range
Dim Factor As Single
Dim i As Long, j As Long

Set Results = Cells(4, 9)
For i = 9 To 101 Step 2 'Amend to suit no. of rows
For j = 4 To 9 Step 5
Set Results = Union(Results, Cells(i, j))
Next j
Next i
If Not Intersect(Target, Results) Is Nothing Then
Enables False
Set Par = Range("A1")
Set Score = Target
Set AH = Target.Offset(, -1)
Set PH = Target.Offset(, -2)
Else
Exit Sub
End If

'Score equals par
If Score = Par Then GoTo NextScore

'Score is less than par
If Score > Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
GoTo NextScore
End If

'Score is greater than par
Select Case PH
Case Is <= 4
Factor = 0.1
Case Is <= 12
Factor = 0.2
Case Is <= 19
Factor = 0.3
Case Is < 27
Factor = 0.4
Case Else
Factor = 0.5
End Select
AH = AH + ((Score - Par) * Factor)
PH = CInt(AH + 0.1)

NextScore:
If Score.End(xlDown).Row = Cells.Rows.Count Then
Range("I9").Activate
ActiveWindow.ScrollRow = 7
Else
Score.Offset(2).Activate
End If
Enables True
End Sub
Function Enables(x As Boolean)
Application.EnableEvents = x
Application.ScreenUpdating = x
End Function
[/VBA]



Hope someone can help with this?

[Bob Phillips]

They look the same to me.

[johnske]

Hi Barry,

It's best to create separate procedures for whatever it is you want to do and just use the change event to call the different procedures (yes, in the same module will do). Something like this...[vba]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
Select Case Target
Case 36
Call DoSomething
Case 72
Call DoSomethingElse
Case Else
'do nothing
End Select
End If
End Sub

Sub DoSomething()
MsgBox "I'm doing something!"
End Sub

Sub DoSomethingElse()
MsgBox "I'm doing something else!"
End Sub[/vba]

[Bob Phillips]

It's best to create separate procedures for whatever it is you want to do...

That depends, if it 99% the same, a single test may be better, saving unnecessarily duplicated code.

[Barryj]

So where it show do something & do something else is that where I put the codes that I have now?

Yes they are identical except one uses greater than and the other uses less than on line If Score Greater Than Par. And for this reason they do slightly different things but with the same result.

[johnske]

So where it show do something & do something else is that where I put the codes that I have now?

Yes they are identical except one uses greater than and the other uses less than on line If Score Greater Than Par. And for this reason they do slightly different things but with the same result.

Yes, that's one way of doing it, you then have completely separate procedures and can modify each one separately until each gives the results you intend. However, as xld said, if they're 99% the same you can avoid duplicated code by rewriting (e.g. using Case or If statements)


EDIT: My original code above had a missing "Not" - this has been corrected now

[mdmackillop]

Hi Barry,
Your first code as written should handle all three posibilities,
Greater than par
Equal to par
Less than par
The Value in A1 is read into the code as Target, and later, Score is set to this value and used in the comparisons.

In your second code, you have modified < to > in one line, without changing the comment, making this both confusing and wrong.
Regards
MD

[VBA]
'Score is less than par
If Score > Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
Goto NextScore
End If

'Score is greater than par
Select Case PH
Case Is <= 4

[/VBA]

[Barryj]

The first Macro works if the score is greater than the target score, the second Macro works if the score is less than the target score, that is why I thought that if the target score was changed it could call the appropiate Macro.

Sorry for the confusing line in the second Macro should have changed the comment line to read if score is less than par.

[mdmackillop]

The single macro deals with both cases. Why do you want two macros?.
You are proposing to have
First macro
[vba]
If Score < Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
Goto NextScore
End If

[/vba]
Second Macro
[vba]
If Score > Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
Goto NextScore
End If

[/vba]
These means you get the same result, regardless of score.

This section will never run because Goto NextScore skips it.
[vba]
'Score is greater than par
Select Case PH
Case Is <= 4
Factor = 0.1
Case Is <= 12 Factor = 0.2 Case Is <= 19
Factor = 0.3
Case Is < 27
Factor = 0.4
Case Else
Factor = 0.5
End Select
AH = AH + ((Score - Par) * Factor)
PH = CInt(AH + 0.1)

[/vba]

[Barryj]

The reason for the 2 Macros is that some times different scoring is used, ie: the first macro is used for Stableford scoring which uses the greater than par to reduce the handicapp.

The second Macro is set for Stroke play which uses less than par to reduce the handicapp.

That is why I thought it would be best to have the two macros and call the required macro that I need.

[mdmackillop]

Hi Barry,
As I understand it, you don't need the macro the run when data in entered in A1, you need it to run when a score is entered, and depending upon the value in A1, different outcomes are required. In this case, you need to call the correct macro and pass data to it to be processed.

Your WorkSheet_Change code, assuming 54 will never be reached by either scoring system, should be something like
[vba]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Results As Range
Set Results = Cells(4, 9)
For i = 9 To 101 Step 2 'Amend to suit no. of rows
For j = 4 To 9 Step 5
Set Results = Union(Results, Cells(i, j))
Next j
Next i
If Not Intersect(Target, Results) Is Nothing Then
If [A1] < 54 then
Call Stableford Target
Else
Call Stroke Target
End if
Else
Exit Sub
End If

[/vba]

[Barryj]

Thanks for the reply, with your code above does that go in the same place as my original code, and do I have to rename my two original codes and how do I do that.

I have renamed and put codes into work book but when running code get a 1004 error on line If Not Intersect(Target, Results) Is Nothing Then in the stableford macro.

Below is what I have so far,

[VBA]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Results As Range
Set Results = Cells(4, 9)
For i = 9 To 101 Step 2 'Amend to suit no. of rows
For j = 4 To 9 Step 5
Set Results = Union(Results, Cells(i, j))
Next j
Next i
If Not Intersect(Target, Results) Is Nothing Then
If [A1] < 54 Then
Call StablefordTarget
Else
Call StrokeTarget
End If
Else
Exit Sub
End If
End Sub


Sub StablefordTarget()
Dim Results As Range, Par As Range, PH As Range
Dim AH As Range, Score As Range
Dim Factor As Single
Dim i As Long, j As Long

Set Results = Cells(4, 9)
For i = 9 To 101 Step 2 'Amend to suit no. of rows
For j = 4 To 9 Step 5
Set Results = Union(Results, Cells(i, j))
Next j
Next i
If Not Intersect(Target, Results) Is Nothing Then
Enables False
Set Par = Range("I4")
Set Score = Target
Set AH = Target.Offset(, -1)
Set PH = Target.Offset(, -2)
Else
Exit Sub
End If

'Score equals par
If Score = Par Then GoTo NextScore

'Score is less than par
If Score < Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
GoTo NextScore
End If

'Score is greater than par
Select Case PH
Case Is <= 4
Factor = -0.1
Case Is <= 12
Factor = -0.2
Case Is <= 19
Factor = -0.3
Case Is < 27
Factor = -0.4
Case Else
Factor = -0.5
End Select
AH = AH + ((Score - Par) * Factor)
PH = CInt(AH + 0.1)

NextScore:
If Score.End(xlDown).Row = Cells.Rows.Count Then
Range("I9").Activate
ActiveWindow.ScrollRow = 7
Else
Score.Offset(2).Activate
End If
Enables True
End Sub

Sub StrokeTarget()
Dim Results As Range, Par As Range, PH As Range
Dim AH As Range, Score As Range
Dim Factor As Single
Dim i As Long, j As Long

Set Results = Cells(4, 9)
For i = 9 To 101 Step 2 'Amend to suit no. of rows
For j = 4 To 9 Step 5
Set Results = Union(Results, Cells(i, j))
Next j
Next i
If Not Intersect(Target, Results) Is Nothing Then
Enables False
Set Par = Range("I4")
Set Score = Target
Set AH = Target.Offset(, -1)
Set PH = Target.Offset(, -2)
Else
Exit Sub
End If

'Score equals par
If Score = Par Then GoTo NextScore

'Score is Greater than par
If Score > Par Then
AH = WorksheetFunction.Min(36, AH + 0.1)
PH = CInt(AH + 0.1)
GoTo NextScore
End If

'Score is greater than par
Select Case PH
Case Is <= 4
Factor = 0.1
Case Is <= 12
Factor = 0.2
Case Is <= 19
Factor = 0.3
Case Is < 27
Factor = 0.4
Case Else
Factor = 0.5
End Select
AH = AH + ((Score - Par) * Factor)
PH = CInt(AH + 0.1)

NextScore:
If Score.End(xlDown).Row = Cells.Rows.Count Then
Range("I9").Activate
ActiveWindow.ScrollRow = 7
Else
Score.Offset(2).Activate
End If
Enables True
End Sub
Function Enables(x As Boolean)
Application.EnableEvents = x
Application.ScreenUpdating = x
End Function
[/VBA]

[mdmackillop]

Hi Barry,
Here's a copy of the spreadsheet incorporating the revised code

[Barryj]

Thankyou so much Mdmackillop for your help on this it works fantastic, exactly as I wanted the end result.