ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   HOW TO MIX TWO MACRO CODES (https://www.excelbanter.com/excel-programming/403429-how-mix-two-macro-codes.html)

K[_2_]

HOW TO MIX TWO MACRO CODES
 
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,
8).Value, Range("AB1:AC9995"), 2, False)
For Each c In MyRange
If c.Address < Target.Address Then
If c.Offset(0, 8).Value = Target.Offset(0, 8).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)"

Bob Phillips

HOW TO MIX TWO MACRO CODES
 
untested

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, 8).Value = .Offset(0, 8).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

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"K" wrote in message
...
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,
8).Value, Range("AB1:AC9995"), 2, False)
For Each c In MyRange
If c.Address < Target.Address Then
If c.Offset(0, 8).Value = Target.Offset(0, 8).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)"




K[_2_]

HOW TO MIX TWO MACRO CODES
 
On Dec 31, 12:05*pm, "Bob Phillips" wrote:
untested

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, 8).Value = .Offset(0, 8).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

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"K" wrote in message

...



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,
8).Value, Range("AB1:AC9995"), 2, False)
For Each c In MyRange
* *If c.Address < Target.Address Then
* * * *If c.Offset(0, 8).Value = Target.Offset(0, 8).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)"- Hide quoted text -


- Show quoted text -


Hi Bob, Thanks for replying. the code you send me is not working can
you please recheck this for me please


All times are GMT +1. The time now is 03:20 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com