Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old April 21st, 2009, 01:58 PM
Authorized User
 
Join Date: Apr 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default Multiple "Worksheet_Change" routines

here is my code, and I need help either combining the two Worksheet_Change routines or getting another way to do this. Thanks in advance
they are basically the same with a few cells different


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address <> "$I$2" Then Exit Sub
 If Target = "GB" Then
     ActiveSheet.Unprotect ("Branches080704")
     Application.EnableEvents = False
     Range("$F$6:$F$8").ClearContents
     Range("$F$4").Locked = False
     Range("$F$5:$F$8").Locked = True
     Range("$G$6:$G$8").Locked = True
     Application.EnableEvents = True
     ActiveSheet.Protect ("Branches080704")
 Else
 If Target.Address <> "$I$2" Then Exit Sub
 If Target = "VC" Then
     ActiveSheet.Unprotect ("Branches080704")
     Application.EnableEvents = False
     Range("$F$4").Locked = False
     Range("$F$6").Locked = False
     Range("$F$7").Locked = False
     Range("$F$8").Locked = False
     Range("$F$5").Locked = True
     Range("$G$6:$G$8").Locked = True
     Application.EnableEvents = True
     ActiveSheet.Protect ("Branches080704")
 Else
 If Target.Address <> "$I$2" Then Exit Sub
 If Target = "DONE" Then
     ActiveSheet.Unprotect ("Branches080704")
     Application.EnableEvents = False
     Range("$F$4").ClearContents
     Range("$F$6:$F$8").ClearContents
     Range("$F$4:$G$8").Locked = True
     Application.EnableEvents = True
     ActiveSheet.Protect ("Branches080704")
 Else
 End If
 End If
 End If
 End Sub
 
 Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address <> "$P$2" Then Exit Sub
 If Target = "GB" Then
     ActiveSheet.Unprotect ("Branches080704")
     Application.EnableEvents = False
     Range("$M$6:$M$8").ClearContents
     Range("$M$4").Locked = False
     Range("$M$5:$M$8").Locked = True
     Range("$N$6:$N$8").Locked = True
     Application.EnableEvents = True
     ActiveSheet.Protect ("Branches080704")
 Else
 If Target.Address <> "$P$2" Then Exit Sub
 If Target = "VC" Then
     ActiveSheet.Unprotect ("Branches080704")
     Application.EnableEvents = False
     Range("$M$4").Locked = False
     Range("$M$6").Locked = False
     Range("$M$7").Locked = False
     Range("$M$8").Locked = False
     Range("$M$5").Locked = True
     Range("$N$6:$N$8").Locked = True
     Application.EnableEvents = True
     ActiveSheet.Protect ("Branches080704")
 Else
 If Target.Address <> "$P$2" Then Exit Sub
 If Target = "DONE" Then
     ActiveSheet.Unprotect ("Branches080704")
     Application.EnableEvents = False
     Range("$M$4").ClearContents
     Range("$M$6:$M$8").ClearContents
     Range("$M$4:$N$8").Locked = True
     Application.EnableEvents = True
     ActiveSheet.Protect ("Branches080704")
 Else
 End If
 End If
 End If
 End Sub
 
Old April 24th, 2009, 04:08 PM
Friend of Wrox
 
Join Date: Feb 2007
Posts: 163
Thanks: 0
Thanked 2 Times in 2 Posts
Default

These functions are for the same worksheet? You can only have one onchange function per sheet.

Also you're using several commands to do the same thing that can be easily grouped together. I've trimmed down your code and hopefully this will make sense to you and make your code easier to read and quicker to process:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

'Not needed so it's remarked but you can exit function here without further processing (Not needed in this case) by checking for both first and having exit if both false
'  If Target.Address <> "$I$2" And Target.Address <> "$P$2" Then Exit Sub

'Your first set of functions is if the target address is $I$2
  If Target.Address = "$I$2" then
    ActiveSheet.Unprotect ("Branches080704")
    Select Case Target.Value
      Case "GB"
        Range("F6:F8").ClearContents
        Range("F4").Locked = False
        Range("F5:F8").Locked = True
        Range("G6:G8").Locked = True
      Case "VC"
        Range("F4:F8").Locked = False 'Save code: Unlock as range since F5 unlocked next line
        Range("F5").Locked = True
        Range("G6:G8").Locked = True
      Case "DONE"
        Range("F4").ClearContents
        Range("F6:F8").ClearContents
        Range("F4:G8").Locked = True
    End Select
    ActiveSheet.Protect ("Branches080704")
  end if

'Your second set of functions is if target address is P2

  If Target.Address <> "$P$2" Then
    ActiveSheet.Unprotect ("Branches080704")
    Select Case Target.Value
      Case "GB"
        Range("M6:M8").ClearContents
        Range("M4").Locked = False
        Range("M5:M8").Locked = True
        Range("N6:N8").Locked = True
      Case "VC"
        Range("M4:M8").Locked = False 'Again lock as range since M5 unlocked next line
        Range("M5").Locked = True
        Range("N6:N8").Locked = True
      Case "DONE"
        Range("M4").ClearContents
        Range("M6:M8").ClearContents
        Range("M4:N8").Locked = True
    End Select
    ActiveSheet.Protect ("Branches080704")
  End If

End Sub

Last edited by allenm; April 24th, 2009 at 04:09 PM.. Reason: Just a spacing issue
 
Old April 29th, 2009, 09:10 AM
Registered User
 
Join Date: Apr 2009
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default Two Worksheet_Change's in one code

Hi Everyone,

I am very new to this forum malarky and vba so would very much appriciate your help on this.
I have managed to mish mash some code and both work individually however as a newbee to this vba stuff I don't know how to get them to work together.
The top code is extended conditional formatting and the second is a date stamp of when there is a cell change event.
Please can you help?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FocusRange As Range
Dim Cell As Range
Set FocusRange = Intersect(Target, [N2:N1000])  'Formatting only applies to cells N2:N1000
If Not FocusRange Is Nothing Then
Target.Parent.Unprotect Password:="brighton"
    For Each Cell In FocusRange.Cells
        Select Case Cell.Text
        Case ""
            Cell.Interior.ColorIndex = 2  'White highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "AB"
            Cell.Interior.ColorIndex = 33  'Sky Bue highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "AG"
            Cell.Interior.ColorIndex = 4  'Bright Green highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "BB"
            Cell.Interior.ColorIndex = 44  'Lt. Orange highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "CH"
            Cell.Interior.ColorIndex = 8     'Turquoise highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "CR"
            Cell.Interior.ColorIndex = 6     'Lt. Orange highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "HG"
            Cell.Interior.ColorIndex = 39  'Lavender highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "JH"
            Cell.Interior.ColorIndex = 41  'Lt. Blue highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "LB"
            Cell.Interior.ColorIndex = 42  'Turquoise highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "MD"
            Cell.Interior.ColorIndex = 37  'Pale Blue highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "MH"
            Cell.Interior.ColorIndex = 46  'Orange highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "NG"
            Cell.Interior.ColorIndex = 7  'Pink highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "NS"
            Cell.Interior.ColorIndex = 14  'Teal highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "RG"
            Cell.Interior.ColorIndex = 50  'Sea Green highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "RJ"
            Cell.Interior.ColorIndex = 34  'Lt. Turquoise highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "RL"
            Cell.Interior.ColorIndex = 54  'Plum highlighting
            Cell.Font.ColorIndex = 2 'White Text
        Case "RO"
            Cell.Interior.ColorIndex = 45  'Lt. Orange highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "RR"
            Cell.Interior.ColorIndex = 15  'Grey - 25% highlighting
            Cell.Font.ColorIndex = xlAutomatic
        Case "SR"
            Cell.Interior.ColorIndex = 55  'Indigo highlighting
            Cell.Font.ColorIndex = 2 'White Text
        Case "ST"
            Cell.Interior.ColorIndex = 13  'Violet highlighting
            Cell.Font.ColorIndex = 2 'White Text
        Case "TA"
            Cell.Interior.ColorIndex = 23  'Ocean Blue highlighting
            Cell.Font.ColorIndex = 2 'White Text
        Case "TN"
            Cell.Interior.ColorIndex = 24  'Ice Blue highlighting
            Cell.Font.ColorIndex = xlAutomatic
 
        End Select
        Target.Parent.Protect Password:="brighton"
    Next Cell
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("N2:N1000"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                With .Offset(0, 5)
.NumberFormat = "DD/MM/YYYY"
.Value = Date
                    End With
                Application.EnableEvents = True
            End If
        End With
    End Sub
Thank you
 
Old April 29th, 2009, 09:30 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 2,189
Thanks: 5
Thanked 59 Times in 57 Posts
Send a message via MSN to gbianchi
Default

Hello. Please the next time use a new thread for your problem.

What do you need to do?? saying work together is not enough, since the two of them do different things.
Also are you sure you want to apply conditional formating every time the user changes a cell???
__________________
HTH

Gonzalo


================================================== =========
Read this if you want to know how to get a correct reply for your question.
(Took that from Doug signature and he Took that from Peter profile)
================================================== =========
My programs achieved a new certification :
WORKS ON MY MACHINE
================================================== =========
I know that CVS was evil, and now i got the
proof.
================================================== =========
 
Old April 29th, 2009, 10:14 AM
Registered User
 
Join Date: Apr 2009
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Apologies.

Basically what I want to achieve is; when someone inputs their initials into a cell in N:N the cell changes to their appropriate colour, at the same time I need to date stamp in corresponding S:S cell when initials was input (this only needs to be dd/mm/yyyy).

So if MD is entered into N10 the colour of the cell changes to blue then in S10 29/04/2009 is automatically populated.

I hope this explains what I am trying to get to.

Thanks
 
Old April 30th, 2009, 09:50 AM
Friend of Wrox
 
Join Date: Feb 2007
Posts: 163
Thanks: 0
Thanked 2 Times in 2 Posts
Default

Remember that you can have only one worksheet change function per worksheet when you're coding. Neither will work right if you have more than one if any of the code for the sheet works at all.

You also used the same statement over and over. Try to think of ways to combine your code so it is smaller. doing so makes it not only easier to read but usually faster executing as well.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FocusRange As Range, Cell As Range, iCellColor As Long, iFontColor As Long
  Set FocusRange = Intersect(Target, [N2:N1000]) 'Formatting only applies to cells N2:N1000
  If Not FocusRange Is Nothing Then
    Target.Parent.Unprotect Password:="brighton"
    For Each Cell In FocusRange.Cells
      iFontColor = xlAutomatic
'Why Was there a case for null string? What if the text in cell is "XYZ" for instance? Changed "" below to Case Else
      Select Case UCase(Cell.Text) 'Changed to upper case so AG, ag, Ag, aG would all be the 'same'
        Case "AB"
          iCellColor = 33  'Sky Bue highlighting
        Case "AG"
          iCellColor = 4  'Bright Green highlighting
        Case "BB"
          iCellColor = 44  'Lt. Orange highlighting
        Case "CH"
          iCellColor = 8     'Turquoise highlighting
        Case "CR"
          iCellColor = 6     'Lt. Orange highlighting
        Case "HG"
          iCellColor = 39  'Lavender highlighting
        Case "JH"
          iCellColor = 41  'Lt. Blue highlighting
        Case "LB"
          iCellColor = 42  'Turquoise highlighting
        Case "MD"
          iCellColor = 37  'Pale Blue highlighting
        Case "MH"
          iCellColor = 46  'Orange highlighting
        Case "NG"
          iCellColor = 7  'Pink highlighting
        Case "NS"
          iCellColor = 14  'Teal highlighting
        Case "RG"
          iCellColor = 50  'Sea Green highlighting
        Case "RJ"
          iCellColor = 34  'Lt. Turquoise highlighting
        Case "RL"
          iCellColor = 54  'Plum highlighting
          iFontColor = 2 'White Text
        Case "RO"
          iCellColor = 45  'Lt. Orange highlighting
        Case "RR"
          iCellColor = 15  'Grey - 25% highlighting
        Case "SR"
          iCellColor = 55  'Indigo highlighting
          iFontColor = 2 'White Text
        Case "ST"
          iCellColor = 13  'Violet highlighting
          iFontColor = 2 'White Text
        Case "TA"
          iCellColor = 23  'Ocean Blue highlighting
          iFontColor = 2 'White Text
        Case "TN"
          iCellColor = 24  'Ice Blue highlighting
        Case Else
          iCellColor = 2  'White highlighting
      End Select
      Cell.Interior.ColorIndex = iCellColor
      Cell.Font.ColorIndex = iFontColor
'This is the other change function you had, they both require column N so contained it inside the same if/then.
'      If .Count = 1 Then 'only dating if 1 cell changes? Remarked so dates all changed cells
      With Cells(Cell.Row, 19)
        .NumberFormat = "DD/MM/YYYY"
        .Value = Date
      End With
'     End If 'only dating if 1 cell changes? Remarked so dates all changed cells
'End of the code used to do the 2nd part of what you wanted done.
    
    Next Cell
    Target.Parent.Protect Password:="brighton"
  End If
'End With 'There is no With statement for this to end
End Sub
Hopes this helps for what you need and gives you some insight for future coding.
 
Old May 1st, 2009, 05:42 AM
Registered User
 
Join Date: Apr 2009
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Fantastic thank you so much.





Similar Threads
Thread Thread Starter Forum Replies Last Post
Reading a files general property of "Type of file" GregSivers Visual Basic 2008 Essentials 7 June 3rd, 2009 09:38 AM
Code not going as planned: "icicle" vs "savedinstancestate" joopthecat BOOK: Professional Android Application Development ISBN: 978-0-470-34471-2 3 May 3rd, 2009 03:09 PM
Chapter-5 on Intents:ContactPickerTester does not show the button "Pick a Contact" sunilm12 BOOK: Professional Android Application Development ISBN: 978-0-470-34471-2 3 April 15th, 2009 11:55 AM
What "build in" funtionality can databound controls use (like GridV.) use with mySQL? allan_ravn ASP.NET 3.5 Professionals 0 April 14th, 2009 03:20 PM
How to download Code in "Professional Active Server Page 3.0 " book. renjith0 All Other Wrox Books 2 April 2nd, 2009 05:06 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.