Consulting

Results 1 to 5 of 5

Thread: Editable Worksheet_Change result

  1. #1

    Editable Worksheet_Change result

    I need your help guys...
    I'm trying to create a 2 events Worksheet_Change macro in one sheet

    It consist of 2 ranges of conditional events

    First conditional range would allow some cell access or no access at all
    and the Second conditional range would fill some cells with Text or no text

    The problem is, for the first condition I need to fill in more than 1 text reference (more than just "ABCD" as the below macro; e.g. "BCDE", "CDEF", etc. )

    And in the second condition, I need the result to be still editable after execution, so that users can still change the text or delete cell contents

    here's what I've done so far:

    [VBA] Public BCell As Range
    Public CCell As Range
    Public vcELL As Boolean

    Public Sub Worksheet_Change(ByVal target As Range)

    Application.EnableEvents = False
    Set BCell = Range("J24")
    Set CCell = Range("Y30")

    If Not BCell Is Nothing Then
    Call isGreat(target)
    Else: BCell = False
    End If
    If Not CCell Is Nothing Then
    Call isGood(target)
    Else: CCell = False
    End If
    Application.EnableEvents = True
    End Sub
    Private Sub isGood(ByVal target As Range)
    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:="123456789"
    If Range("$Y$30").Value = "ABCD" Then
    Range("$z$30:$aa$38").Locked = False
    Range("$z$30:$aa$38").Interior.ColorIndex = 19
    ActiveSheet.Protect Password:="123456789"



    Else
    Range("$z$30:$aa$38").Locked = True
    Range("$z$30:$aa$38").Value = " "
    Range("$z$30:$aa$38").Interior.ColorIndex = 15
    ActiveSheet.Protect Password:="123456789"

    End If
    Application.EnableEvents = True
    End Sub
    Private Sub isGreat(ByVal target As Range)
    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:="123456789"

    If Range("$J$24").Value = "WXYZ" Then
    Range("$AA$47").Value = ("ANY TEXT")
    Range("$AA$48").Value = "ANY OTHER TEXT"
    Range("$AA$47:$AA$48").Locked = False

    ActiveSheet.Protect Password:="123456789"

    Else
    Range("$AA$47").ClearContents

    Range("$AA$48").ClearContents
    Range("$AA$47:$AA$48").Locked = False
    ActiveSheet.Protect Password:="123456789"

    End If

    Application.EnableEvents = False
    ActiveSheet.Protect Password:="123456789"

    End Sub
    Private Sub Worksheet_SelectionChange(ByVal target As Excel.Range)
    'Do nothing if more than one cell is changed or content deleted
    If target.Cells.Count > 1 Then
    vcELL = False
    ' Only activate if in area with our special values
    ElseIf Intersect(target, Range("J24")) Is Nothing Then
    vcELL = False
    ElseIf Intersect(target, Range("y30")) Is Nothing Then
    vcELL = False
    Else

    vcELL = True
    Set CCell = target
    End If
    End Sub[/VBA]

  2. #2
    Knowledge Base Approver VBAX Master Oorang's Avatar
    Joined
    Jan 2007
    Posts
    1,135
    Location
    Hi TM,
    Welcome to the board. I am not sure I completely understood what you were asking but it sounds like you needed to be able to see if a range of cells was in an approved range or not. If that is what you are asking see the example I posted below. If not please clarify and I or someone else will be happy to help
    [vba]Option Explicit
    Private Const strApprovedRange_c As String = "$A$1:$A$10"
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rngApproved As Excel.Range
    Set rngApproved = Me.Range(strApprovedRange_c)
    If IsCellInRange(rngApproved, Target) Then
    VBA.MsgBox "You just changed an approved cell."
    Else
    VBA.MsgBox "You just changed an unapproved cell."
    End If
    End Sub
    Public Function IsCellInRange(ApprovedRange As Excel.Range, _
    TestCell As Excel.Range) As Boolean
    Const strProcedureName_c As String = "IsCellInRange"
    Const lngOne_c As Long = 1
    Const lngErrRangeNotCell_c As Long = vbObjectError + 513
    Const strErrRangeNotCell_c As String = _
    "The Range argument ""TestCell"" may contain only one cell."
    Dim rngTest As Excel.Range
    If TestCell.Cells.Count > lngOne_c Then
    VBA.Err.Raise lngErrRangeNotCell_c, strProcedureName_c, _
    strErrRangeNotCell_c
    End If
    Set rngTest = Excel.Intersect(ApprovedRange, TestRange)
    IsCellInRange = Not rngTest Is Nothing
    End Function[/vba]
    Cordially,
    Aaron



    Keep Our Board Clean!
    • Please Mark your thread "Solved" if you get an acceptable response (under thread tools).
    • Enclose your code in VBA tags then it will be formatted as per the VBIDE to improve readability.

  3. #3
    Administrator
    2nd VP-Knowledge Base
    VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Hey Aaron,

    At a quick glance:
    [VBA]Private Const strApprovedRange_c As String = "$A1$A10"
    ' ----Should be
    Private Const strApprovedRange_c As String = "$A1:$A10"[/VBA]




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  4. #4
    Knowledge Base Approver VBAX Master Oorang's Avatar
    Joined
    Jan 2007
    Posts
    1,135
    Location
    Sloppy Sloppy
    Cordially,
    Aaron



    Keep Our Board Clean!
    • Please Mark your thread "Solved" if you get an acceptable response (under thread tools).
    • Enclose your code in VBA tags then it will be formatted as per the VBIDE to improve readability.

  5. #5

    Smile Solved : Worksheet Change with 2 events (one editable)

    I've done it,

    Thanks for the input though Oorang and Malik..

    Basically I wanted to have a form with 2 conditions

    1st condition: I want user to insert some correct code in order for them to be able to access certain cells (if not correct then the cells is automatically protected)

    2nd condition:If user insert a certain code in other designated cell, then some other cell value is changed based on the code inserted, but this result can also still be edited by the user with a certain information defined previously

    Cheers..
    TM
    -----------------------------------------------------------------------
    [VBA]
    Public BCell As Range
    Public CCell As Range
    Public VCell As Boolean




    Public Sub Worksheet_Change(ByVal target As Range)
    If target.Cells.Count > 1 Then Exit Sub


    ' Only activate if in area with our special values
    If Intersect(target, Range("$J$24,$Y$30")) Is Nothing Then Exit Sub


    Application.EnableEvents = False
    Set BCell = Range("$J$24")
    Set CCell = Range("$Y$30")

    If Not BCell Is Nothing Then
    Call isGreat(target)
    Else: BCell = False
    End If
    If Not CCell Is Nothing Then
    Call isNice(target)
    Else: CCell = False
    End If
    Application.EnableEvents = True
    End Sub


    Private Sub isNice(ByVal target As Range)
    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:="123456789"

    If isGood(target.Value) Then
    Range("$Z$30:$AA$38").Locked = False
    Range("$Z$30:$AA$38").Interior.ColorIndex = 19
    Range("$Z$30").Select
    ActiveSheet.Protect Password:="123456789"
    Application.EnableEvents = False

    Else

    Range("$Z$30:$AA$38").Locked = True
    Range("$Z$30:$AA$38").Value = " "
    Range("$Z$30:$AA$38").Interior.ColorIndex = 15
    Range("$Z$30").Select
    ActiveSheet.Protect Password:="123456789"
    Application.EnableEvents = False
    End If
    Application.EnableEvents = True
    End Sub
    Private Sub isGreat(ByVal target As Range)

    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:="123456789"
    If Range("$J$24").Value = "XXXX" Then

    Range("$AA$47").Value = "AAAA"
    Range("$AA$48").Value = "BBBB"

    Range("$AA$47").Select

    ActiveSheet.Protect Password:="123456789"
    Application.EnableEvents = False
    Else

    Range("$AA$47").Value = ""
    Range("$AA$48").Value = ""
    Range("$aa$47").Select
    ActiveSheet.Protect Password:="123456789"
    Application.EnableEvents = False
    End If
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="123456789"

    End Sub
    Function isGood(X As String) As Boolean

    isGood = False
    If X = "ABCD" Then
    isGood = True
    ElseIf X = "BCDE" Then
    isGood = True
    ElseIf X = "CDEF" Then
    isGood = True




    End If
    End Function
    Private Sub Worksheet_SelectionChange(ByVal target As Excel.Range)
    'Do nothing if more than one cell is changed or content deleted
    If target.Cells.Count > 1 Then
    VCell = False
    ' Only activate if in area with our special values
    ElseIf Intersect(target, Range("$J$24")) Is Nothing Then
    VCell = False
    ElseIf Intersect(target, Range("$Y$30")) Is Nothing Then
    VCell = False
    Else

    VCell = True
    Set CCell = target
    Set BCell = target

    End If
    End Sub[/VBA]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •