Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Combine Two Different Worksheet_Change codes

I am trying to combine two different Worksheet_Change codes. Both
accomplish different things, but it appears that anyway I combine
them, either one works and the other doesn't or neither do. I am not
experienced enough to know where the conflict is. Can anyone help?

Thanks in advance
magmike

PS: I am assuming that they cannot be seperately listed.

Code 1
----------------------------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim n As Long, s As String
On Error GoTo enditall
If Target.Column = 5 Then '1 is column A
Application.EnableEvents = False
n = Target.Row: s = UCase$(Target)

With Range("N" & n)
If IsEmpty(.Value) Then
.Value = Format(Date, "mm-dd-yyyy")
End If
End With

Select Case s
Case "IN", Range("O" & n) = ""
Range("O" & n) = Format(Date, "mm-dd-yyyy")


Case "QUOTE", Range("P" & n) = ""
Range("P" & n) = Format(Date, "mm-dd-yyyy")

Case "EMAIL", Range("P" & n) = ""
Range("P" & n) = Format(Date, "mm-dd-yyyy")

Case "SENT", Range("Q" & n) = ""
Range("Q" & n) = Format(Date, "mm-dd-yyyy")


Case "REQ", Range("R" & n) = ""
Range("R" & n) = Format(Date, "mm-dd-yyyy")


Case "DONE", Range("S" & n) = ""
Range("S" & n) = Format(Date, "mm-dd-yyyy")
End Select
Range("T" & n) = Format(Date, "mm-dd-yyyy")


enditall:
Application.EnableEvents = True
End If
End Sub


Code 2
----------------------
' Downloaded from www.contextures.com
'---------------------------------------------------------------------------------------
' Procedure : Worksheet_Change
' Author : Roger Govier, Technology 4 U
' Date : 09-Mar-2008
' Purpose :To enable filtering without having to use the dropdown
arrows
' :Especially useful in XL2007 where you need to
deselect all before making
' :a selection. Also save the need to invoke the
Custom dialogue
' :Highlighting of cells with the criteria allows easy
view of what selections have been made.
' :The code was inspired by a discussion with Dr Peter
Grebenik, Brookes University
' :Oxford, who had used something similar in his work.
'---------------------------------------------------------------------------------------
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As
String

'Set this next value to the row number above your filter
Const testrow = 1
'Change the marker to something other than the caret ^ if required
marker = "^"

On Error GoTo Worksheet_Change_Error

rownum = Target.Row
colnum = Target.Column
On Error Resume Next

If Target.Count 1 Then
ActiveSheet.ShowAllData
Target.Interior.ColorIndex = -4142 'clear colour from range
GoTo cleanup
End If

If rownum < testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)

If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1),
marker, "")
optype = xlAnd
End If

If caret2 Then
optype = xlOr
End If

If Val(Application.Version) < 11 Then GoTo earlyversion

Set mylist = ActiveSheet.ListObjects
If mylist.Count Then ' A List or Table Object is used
tblname = mylist(1).Name

If Cells(rownum, colnum).Value = "" Then ' No filter choice
mylist(tblname).Range.AutoFilter Field:=colnum
GoTo cleanup
ElseIf caret Then
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
GoTo cleanup
Else
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1
GoTo cleanup
End If

' There is no List object, it is a Range so treat the same as
' earlier versions of Excel

End If

earlyversion:
'This version of Excel does not support List Objects
If Cells(rownum, colnum).Value = "" Then
Selection.AutoFilter Field:=colnum
ElseIf caret Then
Selection.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
Else
Selection.AutoFilter Field:=colnum, Criteria1:=crit1
End If

cleanup:
'keep focus on same cell and set colour index if Selection is made
Range(Target.Address).Activate
If ActiveCell < "" Then
ActiveCell.Interior.ColorIndex = 40 'change to colour of your
choice
Else
ActiveCell.Interior.ColorIndex = -4142
End If


On Error GoTo 0
Exit Sub

Worksheet_Change_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Worksheet_Change of VBA Document Sheet4"
ActiveCell.Interior.ColorIndex = -4142
On Error GoTo 0
End Sub



  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 829
Default Combine Two Different Worksheet_Change codes

"magmike" wrote:
I am trying to combine two different Worksheet_Change codes.


The simplest approach is: rename the first Worksheet_Change procedure as
Part1 and the second as Part2. Then enter the following Worksheet_Change
procedu

Private Sub Worksheet_Change(ByVal Target As Range)
Part1 Target
Part2 Target
End Sub

Of course, there might be some optimization that you could also do. But the
above is the minimum effort needed.

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Combine Two Different Worksheet_Change codes

On Jan 21, 11:39*am, "joeu2004" wrote:
"magmike" wrote:
I am trying to combine two different Worksheet_Change codes.


The simplest approach is: *rename the first Worksheet_Change procedure as
Part1 and the second as Part2. *Then enter the following Worksheet_Change
procedu

Private Sub Worksheet_Change(ByVal Target As Range)
Part1 Target
Part2 Target
End Sub

Of course, there might be some optimization that you could also do. *But the
above is the minimum effort needed.


If I catch what you are saying correctly, then I would have a total of
3 Procedures:

Private Sub Part1(ByVal Target As Excel.Range)
Private Sub Part2(ByVal Target As Range)
Private Sub Worksheet_Change(ByVal Target As Range)

And the Worksheet_Change procedure would be exactly this (without any
changes?):

Private Sub Worksheet_Change(ByVal Target As Range)
Part1 Target
Part2 Target
End Sub

This is what I have done, and neither of them work. I am sure I didn't
something wrong. Did I understand you correctly?

magmike

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Combine Two Different Worksheet_Change codes

On Jan 21, 12:24*pm, magmike wrote:
On Jan 21, 11:39*am, "joeu2004" wrote:

"magmike" wrote:
I am trying to combine two different Worksheet_Change codes.


The simplest approach is: *rename the first Worksheet_Change procedure as
Part1 and the second as Part2. *Then enter the following Worksheet_Change
procedu


Private Sub Worksheet_Change(ByVal Target As Range)
Part1 Target
Part2 Target
End Sub


Of course, there might be some optimization that you could also do. *But the
above is the minimum effort needed.


If I catch what you are saying correctly, then I would have a total of
3 Procedures:

Private Sub Part1(ByVal Target As Excel.Range)
Private Sub Part2(ByVal Target As Range)
Private Sub Worksheet_Change(ByVal Target As Range)

And the Worksheet_Change procedure would be exactly this (without any
changes?):

Private Sub Worksheet_Change(ByVal Target As Range)
Part1 Target
Part2 Target
End Sub

This is what I have done, and neither of them work. I am sure I didn't
something wrong. Did I understand you correctly?

magmike


Forget my previous post - I'm not sure why it wasn't working to begin
with, or what I did to get it working, but it works like a charm now!

Thanks!
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Combine Two Different Worksheet_Change codes

magmike used his keyboard to write :
I am trying to combine two different Worksheet_Change codes. Both
accomplish different things, but it appears that anyway I combine
them, either one works and the other doesn't or neither do. I am not
experienced enough to know where the conflict is. Can anyone help?

Thanks in advance
magmike

PS: I am assuming that they cannot be seperately listed.

Code 1
----------------------------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim n As Long, s As String
On Error GoTo enditall
If Target.Column = 5 Then '1 is column A
Application.EnableEvents = False
n = Target.Row: s = UCase$(Target)

With Range("N" & n)
If IsEmpty(.Value) Then
.Value = Format(Date, "mm-dd-yyyy")
End If
End With

Select Case s
Case "IN", Range("O" & n) = ""
Range("O" & n) = Format(Date, "mm-dd-yyyy")


Case "QUOTE", Range("P" & n) = ""
Range("P" & n) = Format(Date, "mm-dd-yyyy")

Case "EMAIL", Range("P" & n) = ""
Range("P" & n) = Format(Date, "mm-dd-yyyy")

Case "SENT", Range("Q" & n) = ""
Range("Q" & n) = Format(Date, "mm-dd-yyyy")


Case "REQ", Range("R" & n) = ""
Range("R" & n) = Format(Date, "mm-dd-yyyy")


Case "DONE", Range("S" & n) = ""
Range("S" & n) = Format(Date, "mm-dd-yyyy")
End Select
Range("T" & n) = Format(Date, "mm-dd-yyyy")


enditall:
Application.EnableEvents = True
End If
End Sub


Code 2
----------------------
' Downloaded from www.contextures.com
'---------------------------------------------------------------------------------------
' Procedure : Worksheet_Change
' Author : Roger Govier, Technology 4 U
' Date : 09-Mar-2008
' Purpose :To enable filtering without having to use the dropdown
arrows
' :Especially useful in XL2007 where you need to
deselect all before making
' :a selection. Also save the need to invoke the
Custom dialogue
' :Highlighting of cells with the criteria allows easy
view of what selections have been made.
' :The code was inspired by a discussion with Dr Peter
Grebenik, Brookes University
' :Oxford, who had used something similar in his work.
'---------------------------------------------------------------------------------------
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As
String

'Set this next value to the row number above your filter
Const testrow = 1
'Change the marker to something other than the caret ^ if required
marker = "^"

On Error GoTo Worksheet_Change_Error

rownum = Target.Row
colnum = Target.Column
On Error Resume Next

If Target.Count 1 Then
ActiveSheet.ShowAllData
Target.Interior.ColorIndex = -4142 'clear colour from range
GoTo cleanup
End If

If rownum < testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)

If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1),
marker, "")
optype = xlAnd
End If

If caret2 Then
optype = xlOr
End If

If Val(Application.Version) < 11 Then GoTo earlyversion

Set mylist = ActiveSheet.ListObjects
If mylist.Count Then ' A List or Table Object is used
tblname = mylist(1).Name

If Cells(rownum, colnum).Value = "" Then ' No filter choice
mylist(tblname).Range.AutoFilter Field:=colnum
GoTo cleanup
ElseIf caret Then
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
GoTo cleanup
Else
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1
GoTo cleanup
End If

' There is no List object, it is a Range so treat the same as
' earlier versions of Excel

End If

earlyversion:
'This version of Excel does not support List Objects
If Cells(rownum, colnum).Value = "" Then
Selection.AutoFilter Field:=colnum
ElseIf caret Then
Selection.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
Else
Selection.AutoFilter Field:=colnum, Criteria1:=crit1
End If

cleanup:
'keep focus on same cell and set colour index if Selection is made
Range(Target.Address).Activate
If ActiveCell < "" Then
ActiveCell.Interior.ColorIndex = 40 'change to colour of your
choice
Else
ActiveCell.Interior.ColorIndex = -4142
End If


On Error GoTo 0
Exit Sub

Worksheet_Change_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Worksheet_Change of VBA Document Sheet4"
ActiveCell.Interior.ColorIndex = -4142
On Error GoTo 0
End Sub


I might suggest putting this behind the 'ThisWorkbook' object in its
Workbook_SheetChange event so you can manage changes to all sheets in
one place/procedure.

Also, I recommend using local scope defined names for your 'selective'
Target ranges so you don't need to rely on using temp vars for row/col
nums. For example: Target.Row or Target.Column can be referred to as
Cells(Target.Row, "N") OR Cells(Target.Row, Target.Column)!<g

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Combine Two Different Worksheet_Change codes

On Jan 21, 12:07*pm, GS wrote:
magmike used his keyboard to write :





I am trying to combine two different Worksheet_Change codes. Both
accomplish different things, but it appears that anyway I combine
them, either one works and the other doesn't or neither do. I am not
experienced enough to know where the conflict is. Can anyone help?


Thanks in advance
magmike


PS: I am assuming that they cannot be seperately listed.


Code 1
----------------------------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
* Dim n As Long, s As String
* On Error GoTo enditall
* If Target.Column = 5 Then *'1 is column A
* * Application.EnableEvents = False
* * n = Target.Row: s = UCase$(Target)


* * With Range("N" & n)
* * * If IsEmpty(.Value) Then
* * * * *.Value = Format(Date, "mm-dd-yyyy")
* * * End If
* * End With


* * Select Case s
* * * Case "IN", Range("O" & n) = ""
* * * *Range("O" & n) = Format(Date, "mm-dd-yyyy")


* * * Case "QUOTE", Range("P" & n) = ""
* * * *Range("P" & n) = Format(Date, "mm-dd-yyyy")


* * * Case "EMAIL", Range("P" & n) = ""
* * * *Range("P" & n) = Format(Date, "mm-dd-yyyy")


* * * Case "SENT", Range("Q" & n) = ""
* * * *Range("Q" & n) = Format(Date, "mm-dd-yyyy")


* * * Case "REQ", Range("R" & n) = ""
* * * *Range("R" & n) = Format(Date, "mm-dd-yyyy")


* * * Case "DONE", Range("S" & n) = ""
* * * *Range("S" & n) = Format(Date, "mm-dd-yyyy")
* * End Select
* * Range("T" & n) = Format(Date, "mm-dd-yyyy")


enditall:
* * Application.EnableEvents = True
* End If
End Sub


Code 2
----------------------
' Downloaded fromwww.contextures.com
'--------------------------------------------------------------------------*-------------
' Procedure : Worksheet_Change
' Author * * *: Roger Govier, Technology 4 U
' Date * * * * : 09-Mar-2008
' Purpose * *:To enable filtering without having to use the dropdown
arrows
' * * * * * * * * :Especially useful in XL2007 where you need to
deselect all before making
' * * * * * * * * :a selection. Also save the need to invoke the
Custom dialogue
' * * * * * * * * :Highlighting of cells with the criteria allows easy
view of what selections have been made.
' * * * * * * * * :The code was inspired by a discussion with Dr Peter
Grebenik, Brookes University
' * * * * * * * * :Oxford, who had used something similar in his work.
'--------------------------------------------------------------------------*-------------
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As
String


'Set this next value to the row number above your filter
Const testrow = 1
'Change the marker to something other than the caret ^ if required
marker = "^"


* *On Error GoTo Worksheet_Change_Error


rownum = Target.Row
colnum = Target.Column
On Error Resume Next


If Target.Count 1 Then
* * ActiveSheet.ShowAllData
* * Target.Interior.ColorIndex = -4142 'clear colour from range
* * GoTo cleanup
End If


If rownum < testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)


If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1),
marker, "")
optype = xlAnd
End If


If caret2 Then
optype = xlOr
End If


If Val(Application.Version) < 11 Then GoTo earlyversion


* * *Set mylist = ActiveSheet.ListObjects
* * *If mylist.Count Then ' A List or Table Object is used
* * * * * * tblname = mylist(1).Name


* * * * If Cells(rownum, colnum).Value = "" Then ' No filter choice
* * * * * * *mylist(tblname).Range.AutoFilter Field:=colnum
* * * * * * *GoTo cleanup
* * * * ElseIf caret Then
* * * * * * mylist(tblname).Range.AutoFilter Field:=colnum, _
* * * * * * Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
* * * * * * GoTo cleanup
* * * * Else
* * * * * * mylist(tblname).Range.AutoFilter Field:=colnum, _
* * * * * * Criteria1:=crit1
* * * * * * GoTo cleanup
* * End If


* * ' There is no List object, it is a Range so treat the same as
* * ' earlier versions of Excel


End If


earlyversion:
'This version of Excel does not support List Objects
* * If Cells(rownum, colnum).Value = "" Then
* * * * Selection.AutoFilter Field:=colnum
* * ElseIf caret Then
* * * * Selection.AutoFilter Field:=colnum, _
* * * * Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
* * Else
* * Selection.AutoFilter Field:=colnum, Criteria1:=crit1
* * End If


cleanup:
'keep focus on same cell and set colour index if Selection is made
Range(Target.Address).Activate
If ActiveCell < "" Then
* * ActiveCell.Interior.ColorIndex = 40 'change to colour of your
choice
Else
* * ActiveCell.Interior.ColorIndex = -4142
* * End If


* *On Error GoTo 0
* *Exit Sub


Worksheet_Change_Error:


* * MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Worksheet_Change of VBA Document Sheet4"
* * ActiveCell.Interior.ColorIndex = -4142
* * On Error GoTo 0
End Sub


I might suggest putting this behind the 'ThisWorkbook' object in its
Workbook_SheetChange event so you can manage changes to all sheets in
one place/procedure.

Also, I recommend using local scope defined names for your 'selective'
Target ranges so you don't need to rely on using temp vars for row/col
nums. For example: Target.Row or Target.Column can be referred to as
Cells(Target.Row, "N") OR Cells(Target.Row, Target.Column)!<g

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc- Hide quoted text -

- Show quoted text -


Garry,

How would I exclude certain sheets from certain procedures behind
"ThisWorkbook"? Most, but not all the sheets in this workbook will
work in this manner.

magmike
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Combine Two Different Worksheet_Change codes

magmike laid this down on his screen :
On Jan 21, 12:07*pm, GS wrote:
magmike used his keyboard to write :





I am trying to combine two different Worksheet_Change codes. Both
accomplish different things, but it appears that anyway I combine
them, either one works and the other doesn't or neither do. I am not
experienced enough to know where the conflict is. Can anyone help?
Thanks in advance
magmike


PS: I am assuming that they cannot be seperately listed.
Code 1
----------------------------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
* Dim n As Long, s As String
* On Error GoTo enditall
* If Target.Column = 5 Then *'1 is column A
* * Application.EnableEvents = False
* * n = Target.Row: s = UCase$(Target)
* * With Range("N" & n)
* * * If IsEmpty(.Value) Then
* * * * *.Value = Format(Date, "mm-dd-yyyy")
* * * End If
* * End With


* * Select Case s
* * * Case "IN", Range("O" & n) = ""
* * * *Range("O" & n) = Format(Date, "mm-dd-yyyy")
* * * Case "QUOTE", Range("P" & n) = ""
* * * *Range("P" & n) = Format(Date, "mm-dd-yyyy")
* * * Case "EMAIL", Range("P" & n) = ""
* * * *Range("P" & n) = Format(Date, "mm-dd-yyyy")
* * * Case "SENT", Range("Q" & n) = ""
* * * *Range("Q" & n) = Format(Date, "mm-dd-yyyy")
* * * Case "REQ", Range("R" & n) = ""
* * * *Range("R" & n) = Format(Date, "mm-dd-yyyy")
* * * Case "DONE", Range("S" & n) = ""
* * * *Range("S" & n) = Format(Date, "mm-dd-yyyy")
* * End Select
* * Range("T" & n) = Format(Date, "mm-dd-yyyy")
enditall:
* * Application.EnableEvents = True
* End If
End Sub


Code 2
----------------------
' Downloaded fromwww.contextures.com
'--------------------------------------------------------------------------*-------------
' Procedure : Worksheet_Change
' Author * * *: Roger Govier, Technology 4 U
' Date * * * * : 09-Mar-2008
' Purpose * *:To enable filtering without having to use the dropdown
arrows
' * * * * * * * * :Especially useful in XL2007 where you need to
deselect all before making
' * * * * * * * * :a selection. Also save the need to invoke the
Custom dialogue
' * * * * * * * * :Highlighting of cells with the criteria allows easy
view of what selections have been made.
' * * * * * * * * :The code was inspired by a discussion with Dr Peter
Grebenik, Brookes University
' * * * * * * * * :Oxford, who had used something similar in his work.
'--------------------------------------------------------------------------*-------------
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As
String


'Set this next value to the row number above your filter
Const testrow = 1
'Change the marker to something other than the caret ^ if required
marker = "^"


* *On Error GoTo Worksheet_Change_Error
rownum = Target.Row
colnum = Target.Column
On Error Resume Next


If Target.Count 1 Then
* * ActiveSheet.ShowAllData
* * Target.Interior.ColorIndex = -4142 'clear colour from range
* * GoTo cleanup
End If


If rownum < testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)
If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1),
marker, "")
optype = xlAnd
End If


If caret2 Then
optype = xlOr
End If


If Val(Application.Version) < 11 Then GoTo earlyversion
* * *Set mylist = ActiveSheet.ListObjects
* * *If mylist.Count Then ' A List or Table Object is used
* * * * * * tblname = mylist(1).Name
* * * * If Cells(rownum, colnum).Value = "" Then ' No filter choice
* * * * * * *mylist(tblname).Range.AutoFilter Field:=colnum
* * * * * * *GoTo cleanup
* * * * ElseIf caret Then
* * * * * * mylist(tblname).Range.AutoFilter Field:=colnum, _
* * * * * * Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
* * * * * * GoTo cleanup
* * * * Else
* * * * * * mylist(tblname).Range.AutoFilter Field:=colnum, _
* * * * * * Criteria1:=crit1
* * * * * * GoTo cleanup
* * End If


* * ' There is no List object, it is a Range so treat the same as
* * ' earlier versions of Excel


End If


earlyversion:
'This version of Excel does not support List Objects
* * If Cells(rownum, colnum).Value = "" Then
* * * * Selection.AutoFilter Field:=colnum
* * ElseIf caret Then
* * * * Selection.AutoFilter Field:=colnum, _
* * * * Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
* * Else
* * Selection.AutoFilter Field:=colnum, Criteria1:=crit1
* * End If


cleanup:
'keep focus on same cell and set colour index if Selection is made
Range(Target.Address).Activate
If ActiveCell < "" Then
* * ActiveCell.Interior.ColorIndex = 40 'change to colour of your
choice
Else
* * ActiveCell.Interior.ColorIndex = -4142
* * End If


* *On Error GoTo 0
* *Exit Sub


Worksheet_Change_Error:


* * MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure Worksheet_Change of VBA Document Sheet4"
* * ActiveCell.Interior.ColorIndex = -4142
* * On Error GoTo 0
End Sub


I might suggest putting this behind the 'ThisWorkbook' object in its
Workbook_SheetChange event so you can manage changes to all sheets in
one place/procedure.

Also, I recommend using local scope defined names for your 'selective'
Target ranges so you don't need to rely on using temp vars for row/col
nums. For example: Target.Row or Target.Column can be referred to as
Cells(Target.Row, "N") OR Cells(Target.Row, Target.Column)!<g

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc- Hide quoted text -

- Show quoted text -


Garry,

How would I exclude certain sheets from certain procedures behind
"ThisWorkbook"? Most, but not all the sheets in this workbook will
work in this manner.

magmike


Since the num of sheets to exclude are the lesser, I'd make a Const
statement to store the these sheetnames in a string at the top of the
module as follows...

Option Explicit

Const msSHEETS_TO_EXCLUDE As String = "Sheet1,Sheet2"

...and use a For Each loop to act on all sheets except those in the
above var.

Example <aircode
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not InStr(msSHEETS_TO_EXCLUDE, wks.Name) 0 Then
'//code to do stuff to other sheets...
End If
Next 'wks

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Combine Two Different Worksheet_Change codes

That code could probably be put so it better self-documents its
intent...

Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If InStr(msSHEETS_TO_EXCLUDE, wks.Name) = 0 Then
'//code to do stuff to other sheets...
End If
Next 'wks

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Combine Two Different Worksheet_Change codes

On Jan 22, 12:25*am, GS wrote:
That code could probably be put so it better self-documents its
intent...

* *Dim wks As Worksheet
* *For Each wks In ThisWorkbook.Worksheets
* * *If InStr(msSHEETS_TO_EXCLUDE, wks.Name) = 0 Then
* * * *'//code to do stuff to other sheets...
* * *End If
* *Next 'wks


In the '//code to do stuff...' section, would I just name the
procedures here, such as this?:

Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If InStr(msSHEETS_TO_EXCLUDE, wks.Name) = 0 Then
Worksheet_Change
End If
Next 'wks

And then include the procedures below this in the ThisWorkbook module?
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Please help combine two simple codes! J.W. Aldridge Excel Programming 3 April 17th 09 04:22 PM
Combine two Codes into one Sheet Steved Excel Programming 2 May 19th 08 02:29 AM
VBA Codes to combine PDF files salut Excel Programming 2 May 3rd 07 05:15 PM


All times are GMT +1. The time now is 08:56 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"