Barryj
03-05-2006, 01:46 AM
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
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
This is the second Macro that would run if 72 was placed in A1
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
Hope someone can help with this?:help
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
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
This is the second Macro that would run if 72 was placed in A1
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
Hope someone can help with this?:help