CONST range macro run functions based on range

**jdeverich** · 12-22-2011, 02:07 AM

Hi Guys,

The idea of the macros below is this.

Macro1:
when you click on any of these cells place user info in a cell

Macro2:
When you click on this other range of cells change the value of this cell to something else

The problem is making both work in one sheet, if you can think of a way to do this I would appreciate your help.

Regards, Jaems

Macro 1:

Option Explicit
Dim previousvalue

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim txtCells As String
        'Record Last Value, before making the change
previousvalue = Target.Value

Const WS_RANGE As String = "e17, d21, d28, d35, d42, d49, d56, d63, d70, d78, d85"  '<=== change to suit

On Error GoTo err_handler
    
Application.EnableEvents = False
    
    If Not Application.Intersect(Target, Range(WS_RANGE)) Is Nothing Then
        With Target


            eSignCell
            
        End With
    End If

    

err_handler:
Application.EnableEvents = True

End Sub

FYI esigncell is just a public function to pick up some user info as follows

Public Sub eSignCell()
On Error Resume Next

    ActiveCell.FormulaR1C1 = eSign()
      
End Sub

Macro2

This code also works but I want the two combined for one range do the below, for the other range of cells do the one above.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error GoTo err_handler
Dim strCell1 As String
Dim strCell2 As String


   Const WS_RANGE As String = "G11:P11"  '<=== change to suit; this defines the clickable cells


    Application.EnableEvents = False
    If Not Application.Intersect(Target, Range(WS_RANGE)) Is Nothing Then
        With Target
            'strGroup = .Offset(-3, 0) '<=== use this to read the Group Name of the changed value for the Log File
                     
            Select Case .Value
                Case "¤":    .Value = "¡"
                .Font.Name = "Wingdings"
                .Font.Color = vbRed
                
                 'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Access to Restricted")
                Case Else:   .Value = "¤"
                .Font.Name = "Wingdings"
                .Font.Color = vbBlue
               
                 'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Restricted to Access")
            End Select
                        
            'Validate the cell, if the cell value is different from Original, if different, change cell colour
            strCell1 = ActiveCell.Offset(0, 0).Value
            strCell2 = ActiveCell.Offset(-1, 0).Value
            If strCell1 <> strCell2 Then .Interior.ColorIndex = 6 Else .Interior.ColorIndex = 0
            
            
            .Offset(1, 0).Select  '<===Move 1 cell down
            
        End With
    End If
    
    
err_handler:
Application.EnableEvents = True



End Sub

**pike** · 12-22-2011, 02:27 AM

Hi jdeverich
Try something like....

Option Explicit
Dim previousvalue

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim txtCells As String
    Dim strCell1 As String
    Dim strCell2 As String
    Dim WS_RANGE As Range
    Dim WS_RANGETwo As Range
    'Record Last Value, before making the change
    previousvalue = Target.Value
    Set WS_RANGE = Range("e17, d21, d28, d35, d42, d49, d56, d63, d70, d78, d85")    '<=== change to suit
    Set WS_RANGETwo = Range("G11:P11")  '<=== change to suit; this defines the clickable cells
    On Error Resume Next
    Application.EnableEvents = False
    If Not Application.Intersect(Target, Range(WS_RANGE)) Is Nothing Then
        With Target
            eSignCell
        End With
    End If
    If Not Application.Intersect(Target, Range(WS_RANGETwo)) Is Nothing Then
        With Target
            'strGroup = .Offset(-3, 0) '<=== use this to read the Group Name of the changed value for the Log File

            Select Case .Value
                Case "¤": .Value = "¡"
                    .Font.Name = "Wingdings"
                    .Font.Color = vbRed

                    'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Access to Restricted")
                Case Else: .Value = "¤"
                    .Font.Name = "Wingdings"
                    .Font.Color = vbBlue
                    'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Restricted to Access")
            End Select

            'Validate the cell, if the cell value is different from Original, if different, change cell colour
            strCell1 = ActiveCell.Offset(0, 0).Value
            strCell2 = ActiveCell.Offset(-1, 0).Value
            If strCell1 <> strCell2 Then .Interior.ColorIndex = 6 Else .Interior.ColorIndex = 0

            .Offset(1, 0).Select  '<===Move 1 cell down

        End With
    End If

    Application.EnableEvents = True
Set WS_RANGE = Nothing
Set WS_RANGETwo = Nothing
End Sub

**jdeverich** · 12-22-2011, 08:42 AM

Access form Template - upload.xlsm

I think we are getting closer however somewhere the code is missing the priciple only to look at the target cells, this is where I got stuck also. The function starts looking at every cell not just the ones selected in the range.

If anyone has an idea appreciate the help.

Regards, James.

**pike** · 12-22-2011, 02:52 PM

Ho Ho Ho

tested this one

Option Explicit
Dim previousvalue

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Dim txtCells As String
    Dim strCell1 As String
    Dim strCell2 As String
    Dim WS_RANGE As Range
    Dim WS_RANGETwo As Range
    'Record Last Value, before making the change
     Application.EnableEvents = True
    previousvalue = Target.Value
    Set WS_RANGE = Application.Intersect(Union(Range("e1"), Range("d21"), Range("d28"), Range("d35"), Range("d42"), Range("d49"), Range("d56"), Range("d63"), Range("d70"), Range("d78"), Range("d85")), Target)    '<=== change to suit
    Set WS_RANGETwo = Application.Intersect(Range("G11:P11"), Target)   '<=== change to suit; this defines the clickable cells
On Error Resume Next
  If Not WS_RANGE Is Nothing Then
        MsgBox "One"
        With Target
               .Value = eSign()
        End With
    End If
    If Not WS_RANGETwo Is Nothing Then
         MsgBox "Two"
        With Target
            'strGroup = .Offset(-3, 0) '<=== use this to read the Group Name of the changed value for the Log File

            Select Case .Value
                Case "¤": .Value = "¡"
                    .Font.Name = "Wingdings"
                    .Font.Color = vbRed

                    'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Access to Restricted")
                Case Else: .Value = "¤"
                    .Font.Name = "Wingdings"
                    .Font.Color = vbBlue
                    'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Restricted to Access")
            End Select

            'Validate the cell, if the cell value is different from Original, if different, change cell colour
            strCell1 = ActiveCell.Offset(0, 0).Value
            strCell2 = ActiveCell.Offset(-1, 0).Value
            If strCell1 <> strCell2 Then .Interior.ColorIndex = 6 Else .Interior.ColorIndex = 0

            .Offset(1, 0).Select  '<===Move 1 cell down

        End With
    End If

    Application.EnableEvents = True
Set WS_RANGE = Nothing
Set WS_RANGETwo = Nothing
End Sub

**jdeverich** · 12-22-2011, 07:39 PM

Access form Template - upload.xlsm
Hi Pike,

Still having trouble think when I take out the "const as string" expression the function stops continuing to watch those cells waiting for someone to click on the cell. So when applying the set caommand as your alternative nothing happens when you click on the cell, the cell is no longer working like a button.

Tricky one!

Regards, James.

**pike** · 12-22-2011, 07:55 PM

which cell?

Set WS_RANGE = Application.Intersect(Union(Range("e17"), Range("d21"), Range("d28"), Range("d35"), Range("d42"), Range("d49"), Range("d56"), Range("d63"), Range("d70"), Range("d78"), Range("d85")), Target)    '<=== change to suit

**pike** · 12-22-2011, 07:58 PM

It works for me in the cells in the intersections

**jdeverich** · 12-22-2011, 09:30 PM

Really? In my sheet it seems to run both functions regardless which cell I click. If its not too much trouble would you mind to upload the file you tested on?

Thanks Heaps!

James.

**pike** · 12-23-2011, 01:36 AM

Try this the attaachment .. If it dosent work I dont know what you are doing so can you expand on the explination

Option Explicit
Dim previousvalue

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Dim txtCells As String
    Dim strCell1 As String
    Dim strCell2 As String
    Dim WS_RANGE As Range
    Dim WS_RANGETwo As Range
    'Record Last Value, before making the change
    Application.EnableEvents = True
    previousvalue = Target.Value
    Set WS_RANGE = Application.Intersect(Union(Range("E17"), Range("d21"), Range("d28"), Range("d35"), Range("d42"), Range("d49"), Range("d56"), Range("d63"), Range("d70"), Range("d78"), Range("d85")), Target)    '<=== change to suit
    Set WS_RANGETwo = Application.Intersect(Range("G11:P11"), Target)   '<=== change to suit; this defines the clickable cells
    On Error Resume Next
    If Not WS_RANGE Is Nothing Then

        With Target
            .Value = eSign()
        End With
    End If
    If Not WS_RANGETwo Is Nothing Then

        With Target
            'strGroup = .Offset(-3, 0) '<=== use this to read the Group Name of the changed value for the Log File

            Select Case .Value
                Case "¤": .Value = "¡"
                    .Font.Name = "Wingdings"
                    .Font.Color = vbRed

                    'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Access to Restricted")
                Case Else: .Value = "¤"
                    .Font.Name = "Wingdings"
                    .Font.Color = vbBlue
                    'LogInformation (ActiveSheet.Name & " - " & Target.Address & " - " & strGroup & " - from Restricted to Access")
            End Select

            'Validate the cell, if the cell value is different from Original, if different, change cell colour
            strCell1 = ActiveCell.Offset(0, 0).Value
            strCell2 = ActiveCell.Offset(-1, 0).Value
            If strCell1 <> strCell2 Then .Interior.ColorIndex = 6 Else .Interior.ColorIndex = 0

            .Offset(1, 0).Select  '<===Move 1 cell down

        End With
    End If

    Application.EnableEvents = True
    Set WS_RANGE = Nothing
    Set WS_RANGETwo = Nothing
End Sub

Access form Template - upload2 Test.zip