Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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)" |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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)" |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
macro codes | Excel Discussion (Misc queries) | |||
Need some macro codes | Excel Discussion (Misc queries) | |||
Macro (Codes) | Excel Programming | |||
VBA codes for macro to continue | Excel Programming | |||
PSW for Macro & Codes | Excel Programming |