COMBINE TWO MACROS INTO ONE
On Dec 31 2007, 5:53*pm, John Bundy (remove) wrote:
You can put them all on the same sheet:
Sub Worksheet_Change(ByVal Target As Range)
Macro1()
Macro2()
End Sub
Private SubMacro1()
Const WS_RANGE As String = "B25:D62,K25:K62"
* * On Error GoTo ws_exit
* * Application.EnableEvents = False
* * If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
* * * * With Target
* * * * * * If Me.Cells(.Row, "B").Value < "" And _
* * * * * * * * Me.Cells(.Row, "C").Value < "" Then
* * * * * * * * If IsError(Application.Match(Me.Cells(.Row,
O).Value, Columns(27), 0)) Then
* * * * * * * * * * MsgBox "NO BUDGET IN AGRESSO", vbInformation,
INFORMATION
* * * * * * * * End If
* * * * * * * * If Me.Cells(.Row, "K").Value = "ZERO BUDGET" Then
* * * * * * * * MsgBox "ZERO BUDGET IN AGRESSO", vbInformation,
INFORMATION
* * * * * * End If
* * * * * * End If
* * * * End With
* * End If
ws_exit:
* * Application.EnableEvents = True
End Sub
Private Sub Macro2()
Dim MyRange As Range
Set MyRange = Range("F25:F62")
* *If Target.Cells.Count 1 Then Exit Sub
* * If Not Intersect(Target, Range("F25:F62")) Is Nothing Then
* * * * If IsNumeric(Target) Then
* * * * * * On Error Resume Next
* * * * * * Application.EnableEvents = False
* * * * * * budget = WorksheetFunction.VLookup(Target.Offset(0,
9).Value, Range("AB1:AC9995"), 2, False)
For Each c In MyRange
* * If c.Address < Target.Address Then
* * * * If c.Offset(0, 9).Value = Target.Offset(0, 9).Value Then
* * * * * *budget = budget + c.Value
* * * * End If
* * End If
Next c
* * * * * *If Target.Value < "" Then
* * * * * * * * Target.Offset(0, 5).Value = budget
* * * * * * Else
* * * * * *Target.Offset(0, 5).Value = ""
* * * * * *End If
* * * * * * * * Application.EnableEvents = True
* * * * * * On Error GoTo 0
* * * * End If
* * End If
End Sub
--
-John
Please rate when your question is answered to help us and others know what
is helpful.
"K" wrote:
On Dec 31, 4:11 pm, John Bundy (remove) wrote:
The easiest way is to just give them names, make one say sub Macro1() and the
other sub macro2(), better names would help:) then just call them from the
worksheet change, so
Private Sub Worksheet_Change(ByVal Target As Range)
macro1
macro2
End sub
--
-John
Please rate when your question is answered to help us and others know what
is helpful.
"K" wrote:
Hi, i have two macro codes and they both are
Private Sub Worksheet_Change(ByVal Target As Range). *I want to mix
them and want to make one code. *Please see the Macros belw
Macro 1:-
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B25:D62,K25:K62"
* * On Error GoTo ws_exit
* * Application.EnableEvents = False
* * If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
* * * * With Target
* * * * * * If Me.Cells(.Row, "B").Value < "" And _
* * * * * * * * Me.Cells(.Row, "C").Value < "" Then
* * * * * * * * If IsError(Application.Match(Me.Cells(.Row,
O).Value, Columns(27), 0)) Then
* * * * * * * * * * MsgBox "NO BUDGET IN AGRESSO", vbInformation,
INFORMATION
* * * * * * * * End If
* * * * * * * * If Me.Cells(.Row, "K").Value = "ZERO BUDGET" Then
* * * * * * * * MsgBox "ZERO BUDGET IN AGRESSO", vbInformation,
INFORMATION
* * * * * * End If
* * * * * * End If
* * * * End With
* * End If
ws_exit:
* * Application.EnableEvents = True
End Sub
Macro 2:-
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Set MyRange = Range("F25:F62")
* *If Target.Cells.Count 1 Then Exit Sub
* * If Not Intersect(Target, Range("F25:F62")) Is Nothing Then
* * * * If IsNumeric(Target) Then
* * * * * * On Error Resume Next
* * * * * * Application.EnableEvents = False
* * * * * * budget = WorksheetFunction.VLookup(Target.Offset(0,
9).Value, Range("AB1:AC9995"), 2, False)
For Each c In MyRange
* * If c.Address < Target.Address Then
* * * * If c.Offset(0, 9).Value = Target.Offset(0, 9).Value Then
* * * * * *budget = budget + c.Value
* * * * End If
* * End If
Next c
* * * * * *If Target.Value < "" Then
* * * * * * * * Target.Offset(0, 5).Value = budget
* * * * * * Else
* * * * * *Target.Offset(0, 5).Value = ""
* * * * * *End If
* * * * * * * * Application.EnableEvents = True
* * * * * * On Error GoTo 0
* * * * End If
* * End If
End Sub
Please can anybody able to tell me that how can i make one macro of
two macros as i cant have two macro in one sheet which starts from
Private Sub Worksheet_Change(ByVal Target As Range)
some one send me the sultion (please see below) but its not working
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE1 As String = "B25:D62,K25:K62"
Const WS_RANGE2 As String = "F25:F62"
* * On Error GoTo ws_exit
* * Application.EnableEvents = False
* * If Target.Cells.Count 1 Then Exit Sub
* * If Not Intersect(Target, Me.Range(WS_RANGE1)) Is Nothing Then
* * * * With Target
* * * * * * If Me.Cells(.Row, "B").Value < "" And _
* * * * * * * * Me.Cells(.Row, "C").Value < "" Then
* * * * * * * * If IsError(Application.Match( _
* * * * * * * * * * Me.Cells(.Row, "O").Value, Columns(27), 0)) Then
* * * * * * * * * * MsgBox "NO BUDGET IN AGRESSO", vbInformation,
"INFORMATION"
* * * * * * * * End If
* * * * * * * * If Me.Cells(.Row, "K").Value = "ZERO BUDGET" Then
* * * * * * * * MsgBox "ZERO BUDGET IN AGRESSO", vbInformation,
"INFORMATION"
* * * * * * End If
* * * * * * End If
* * * * End With
* * ElseIf Not Intersect(Target, Range(WS_RANGE2)) Is Nothing Then
* * * * If IsNumeric(Target) Then
* * * * * * With Target
* * * * * * * * *On Error Resume Next
* * * * * * * * *Application.EnableEvents = False
* * * * * * * * *budget = WorksheetFunction.VLookup( _
* * * * * * * * * * .Offset(0, 8).Value, Range("AB1:AC9995"), 2,
False)
* * * * * * * * *For Each c In MyRange
* * * * * * * * * * *If c.Address < Target.Address Then
* * * * * * * * * * * * *If c.Offset(0, 9)..Value = .Offset(0, 9).Value
Then
* * * * * * * * * * * * * * budget = budget + c.Value
* * * * * * * * * * * * *End If
* * * * * * * * * * *End If
* * * * * * * * *Next c
* * * * * * * * *.Offset(0, 5).Value = IIf(.Value < "", _
* * * * * * * * * * budget, .Offset(0, 5).Value = "")
* * * * * * * * *On Error GoTo 0
* * * * * * End With
* * * * End If
* * End If
ws_exit:
* * Application.EnableEvents = True
End Sub- Hide quoted text -
- Show quoted text -
Thanks for replying John. *but i need it in the sheet as i need to
copy the worksheet into other places and if i copy it i need to copy
the macro as well but if i have a combine code in sheet then i dont
need to copy the macro as the worksheet macro get copy it self when
you copy the sheet to some other place. *can you please help me that
how can i combine this code- Hide quoted text -
- Show quoted text -
Thanks for replying John and Rick. I'll let you know after appling
this code
|