UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Select Case Not Working, Office 2013    
 
   
wornout
post Feb 16 2017, 02:40 PM
Post#1



Posts: 883
Joined: 17-November 13
From: Orewa New Zealand


I have tried to do this on my own but I can not seem to get it to work it does not recognize when I click on a cell in one of those ranges what have I done wrong

CODE
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "xxxxxx"

Select Case Target.Address
Case "$B$5:$H$5", "$B$16:$H$16", "$B$27:$H$27", "$B$38:$H$38", "$B$49:$H$49", "$B$60:$H$60"


Range("R2").Value = ActiveCell.Value

Sheets("CalendarItems").Range("Table1[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("R1:R2"), CopyToRange:=Range( _
        "Calendar!Extract"), Unique:=False
    Sheets("Calendar").Select
Static rng As Range
    If Not rng Is Nothing Then rng.Interior.ColorIndex = xlNone
    Set rng = Target
    rng.Interior.Color = vbYellow

UserForm2.Show

End Select

   ActiveSheet.Protect "xxxxx", DrawingObjects:=True, Contents:=True, Scenarios:=True
  



  
End Sub

This post has been edited by wornout: Feb 16 2017, 02:40 PM
Go to the top of the page
 
ADezii
post Feb 16 2017, 03:41 PM
Post#2



Posts: 1,563
Joined: 4-February 07
From: USA, Florida, Delray Beach


If I understand correctly, you need to detect if a Clicked Cell falls within a Specified Range. The following Code example will notify the User as to whether or not a Click Cell falls within the '$A$1:$B$6' Range:
CODE
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iSect As Excel.Range

Set iSect = Application.Intersect(Range("$A$1:$B$6"), Target)

If iSect Is Nothing Then
  MsgBox "Ranges do not Intersect"
Else
  MsgBox "Ranges Intersect"
End If
End Sub
Go to the top of the page
 
wornout
post Feb 16 2017, 03:53 PM
Post#3



Posts: 883
Joined: 17-November 13
From: Orewa New Zealand


Ok I tried that I put
Set iSect = Application.Intersect(Range("$B$5:$H$5", "$B$16:$H$16", "$B$27:$H$27", "$B$38:$H$38", "$B$49:$H$49", "$B$60:$H$60"), Target)
and it said wrong number of arguments or invalid property assignment and Highlighted range in blue
Go to the top of the page
 
wornout
post Feb 16 2017, 07:39 PM
Post#4



Posts: 883
Joined: 17-November 13
From: Orewa New Zealand


I solved it
CODE
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

ActiveSheet.Unprotect "alleycat"
    Select Case Target.Address
        Case "$B$5", "$B$16", "$B$27", "$B$38", "$B$49$", "$B$60"
           ActiveSheet.Unprotect "alleycat"

Range("R2").Value = ActiveCell.Value

Sheets("CalendarItems").Range("Table1[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("R1:R2"), CopyToRange:=Range( _
        "Calendar!Extract"), Unique:=False
    Sheets("Calendar").Select
Static rng As Range
    If Not rng Is Nothing Then rng.Interior.ColorIndex = xlNone
    Set rng = Target
    rng.Interior.Color = vbYellow
UserForm2.Show
Case "$C$5", "$C$16", "$C$27", "$C$38", "$C$49", "$C$60"
  ActiveSheet.Unprotect "alleycat"

Range("R2").Value = ActiveCell.Value

Sheets("CalendarItems").Range("Table1[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("R1:R2"), CopyToRange:=Range( _
        "Calendar!Extract"), Unique:=False
    Sheets("Calendar").Select
    If Not rng Is Nothing Then rng.Interior.ColorIndex = xlNone
    Set rng = Target
    rng.Interior.Color = vbYellow
UserForm2.Show

and so on
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    23rd May 2017 - 09:16 PM