Forum Discussion

Bryan Kospender's avatar
Bryan Kospender
Copper Contributor
Jan 30, 2018

Sort Arrows not working on table heading

I recently followed a short tutorial to add a time picker into my project. This is the code...

 

Private Sub Worksheet_Deactivate()
Dim TP As Shape
On Error Resume Next
Set TP = Shapes("TimePickGrp")
On Error GoTo 0
If TP Is Nothing Then 'Shape Deleted
    Application.EnableEvents = False
    On Error Resume Next
    Application.Undo
    Application.EnableEvents = True
End If
End Sub

Private Sub DTPicker21_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim userSelectedDate As Date
            
    'Show calendar form if selected cell falls within "DateRange" named range
    If Not Intersect(ActiveCell, Sheet1.Range("DateRange")) Is Nothing Then
        If IsDate(ActiveCell.value) Then userSelectedDate = ActiveCell.value
    
        'Call CalendarForm
        userSelectedDate = CalendarForm.GetDate(SelectedDate:=userSelectedDate)
            
        'Make sure user selected a valid date from the CalendarForm
        If userSelectedDate <> 0 Then ActiveCell.value = userSelectedDate
    End If



Dim TP As Shape
On Error Resume Next
Set TP = Shapes("TimePickGrp")
On Error GoTo 0
If TP Is Nothing Then 'Shape Deleted
    Application.EnableEvents = False
    On Error Resume Next
    Application.Undo
    On Error GoTo 0
    Application.EnableEvents = True
End If
If Not Intersect(Target, Range("E2:E211")) Is Nothing Then
'If Sheet is Protected, add Unprotect Code here such as ActiveSheet.Unprotect "Password"
ActiveSheet.Unprotect "****"
    TPShow
 Else:
    Shapes("TimePickGrp").Visible = msoFalse
End If
End Sub

*Note I changed the ActiveSheet.Unprotect "Password" part to ***** so I don't have to give away a password I use.

 

 

Anyway, this code and module works great when not using a protected sheet, however I wanted my sheet to be protected, so I had to add in the ActiveSheet.Unprotect "Password" line as instructed by the ---> 'If Sheet is Protected, add Unprotect Code here such as ActiveSheet.Unprotect "Password"

 

You also have to add it into the module code.... see here

 

Option Explicit
Sub UnProtTP()
On Error Resume Next
ActiveSheet.Shapes("TimePickGrp").Ungroup
On Error GoTo 0
 'Add in any Unprotect sheet code here such as ActiveSheet.Unprotect "Password"
 ActiveSheet.Unprotect "*****"
'Application.ScreenUpdating = False
Application.ScreenUpdating = False
End Sub
Sub ProtTP()
Dim GrpRange, GrpShapes
On Error GoTo ExitSub
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("MainBack", "BackCircle", "HrsGrp", "8Sel", _
        "9Sel", "10Sel", "11Sel", "12Sel", "1Sel", "2Sel", "3Sel", "4Sel", "5Sel", _
        "HrsDisp", "Colon", "MinDisp", "AMPM", "AMAct", "PMInact", "DivLine", "DoneBtn" _
        , "SettingsBtn", "6Sel", "7Sel", "MinGrp", "PMAct", "AMInact", "00MSel", _
        "05MSel", "10MSel", "15MSel", "20MSel", "25MSel", "30MSel", "35MSel", "40MSel", _
        "45MSel", "50MSel", "55MSel", "SetGrp"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "TimePickGrp"
      ActiveSheet.Shapes("TimePickGrp").Placement = 2
ExitSub:
'Add in any Protect sheet code here such as ActiveSheet.Protect "Password"
ActiveSheet.Protect "*****"
'Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub
Sub TPShow()
Dim SelCell As Range
Dim Hr As Long
'On Error GoTo NoTP
 'If Sheet is Protected, add Unprotect Code here such as ActiveSheet.Unprotect "Password"
 ActiveSheet.Unprotect "*****"
With ActiveSheet.Shapes("TimePickGrp")
Set SelCell = Selection
    .Visible = msoCTrue
   ' On Error Resume Next
    .Left = SelCell.Left
    .Top = SelCell.Offset(1, 0).Top
  ' On Error GoTo 0
End With
UnProtTP
HideHrSel
HideMinSel
'Check for Links from another workbook
UnGrpSet
If InStr(ActiveSheet.Shapes("5Pie1").OnAction, "!") <> 0 Then  'Run Workbook Link Remover
    UnGrpHrs
    UnGrpMin
    MacroLinkRemover
    GrpHrs
    GrpMin
    GrpSet
Else:
GrpSet
End If
If ActiveCell.value <> Empty Then Hr = Format(ActiveCell.value, "hh")
If Hr >= 13 Then Hr = Hr - 12
If Hr = 0 Then Hr = 12

If ActiveCell.value <> Empty Then ActiveSheet.Shapes("HrsDisp").TextFrame.Characters.Text = Hr
If ActiveCell.value <> Empty Then ActiveSheet.Shapes("MInDisp").TextFrame.Characters.Text = Right(Format(ActiveCell.value, "h:mm"), 2)
If ActiveCell.value <> Empty Then ActiveSheet.Shapes("AMPM").TextFrame.Characters.Text = Format(ActiveCell.value, "AM/PM")
ActiveSheet.Shapes("SetGrp").Visible = msoFalse
HoursDisplay
ProtTP
 'If Sheet is Protected, Add Protection Code here such as ActiveSheet.Protect "Password"
 ActiveSheet.Protect "*****"
Exit Sub
NoTP:
MsgBox "The Time Picker has been removed from this sheet. Please copy the entire Time Picker from another sheet and paste it into this sheet"
 'If Sheet is Protected, Add Protection Code here such as ActiveSheet.Protect "Password"
 ActiveSheet.Protect "*****"
End Sub
Sub HoursDisplay()
Dim Siz, CurLeft, CurTop As Long
With ActiveSheet
UnProtTP
HideMinSel
HideHrSel
.Shapes("MinDisp").TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Shapes("HrsDisp").TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
If ActiveCell.value = Empty Then 'Set Default TIme to 12PM
    .Shapes("HrsDisp").TextFrame.Characters.Text = "12"
    .Shapes("MinDisp").TextFrame.Characters.Text = "00"
    .Shapes("AMPM").TextFrame.Characters.Text = "PM"
End If
.Shapes("MinGrp").Visible = False
    With .Shapes("HrsGrp")
    .Visible = True
    CurLeft = .Left
    CurTop = .Top
            For Siz = 180 To 152 Step -4
                .Width = Siz
                .Height = Siz
                .Left = 152 - Siz + CurLeft
                .Top = 152 - Siz + CurTop
                Application.Wait (Now + 0#)
            Next Siz
    End With
On Error Resume Next
.Shapes(.Shapes("HrsDisp").TextFrame.Characters.Text & "Sel").Visible = True
On Error GoTo 0
ProtTP
End With
End Sub
Sub MinDisplay()
Dim Siz, CurLeft, CurTop As Long
Dim Inter As String
Dim Intg5, Intg10, Intg15 As Integer
With ActiveSheet
UnProtTP
Intg5 = .Shapes("5MinTxt").Fill.Visible
Intg10 = .Shapes("10MinTxt").Fill.Visible
Intg15 = .Shapes("15MinTxt").Fill.Visible
If Intg5 = -1 Then Inter = "5M"
If Intg10 = -1 Then Inter = "10M"
If Intg15 = -1 Then Inter = "15M"

HideHrSel
.Shapes("HrsDisp").TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Shapes("MInDisp").TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Shapes("HrsGrp").Visible = False
.Shapes("MinGrp").Visible = True
If Inter = "10M" Or Inter = "15M" Then .Shapes("05Min").Visible = False
If Inter = "15M" Then .Shapes("10Min").Visible = False
If Inter = "10M" Then .Shapes("15Min").Visible = False
If Inter = "15M" Then .Shapes("20Min").Visible = False
If Inter = "10M" Or Inter = "15M" Then .Shapes("25Min").Visible = False
If Inter = "10M" Or Inter = "15M" Then .Shapes("35Min").Visible = False
If Inter = "15M" Then .Shapes("40Min").Visible = False
If Inter = "10M" Then .Shapes("45Min").Visible = False
If Inter = "15M" Then .Shapes("50Min").Visible = False
If Inter = "10M" Or Inter = "15M" Then .Shapes("55Min").Visible = False
    With .Shapes("MinGrp")
'    .Visible = True
    CurLeft = .Left
    CurTop = .Top
            For Siz = 126 To 152 Step 2
                .Width = Siz
                .Height = Siz
                .Left = 152 - Siz + CurLeft
                .Top = 152 - Siz + CurTop
                Application.Wait (Now + 0#)
            Next Siz
    End With
On Error Resume Next
.Shapes(.Shapes("MinDisp").TextFrame.Characters.Text & "MSel").Visible = True
On Error GoTo 0
ProtTP
End With
End Sub
Sub HideHrSel()
With ActiveSheet
.Shapes("1Sel").Visible = False
.Shapes("2Sel").Visible = False
.Shapes("3Sel").Visible = False
.Shapes("4Sel").Visible = False
.Shapes("5Sel").Visible = False
.Shapes("6Sel").Visible = False
.Shapes("7Sel").Visible = False
.Shapes("8Sel").Visible = False
.Shapes("9Sel").Visible = False
.Shapes("10Sel").Visible = False
.Shapes("11Sel").Visible = False
.Shapes("12Sel").Visible = False
End With
End Sub
Sub HideMinSel()
With ActiveSheet
.Shapes("05MSel").Visible = False
.Shapes("10MSel").Visible = False
.Shapes("15MSel").Visible = False
.Shapes("20MSel").Visible = False
.Shapes("25MSel").Visible = False
.Shapes("30MSel").Visible = False
.Shapes("35MSel").Visible = False
.Shapes("40MSel").Visible = False
.Shapes("45MSel").Visible = False
.Shapes("50MSel").Visible = False
.Shapes("55MSel").Visible = False
.Shapes("00MSel").Visible = False
End With
End Sub
Sub AMPMSel()
If ActiveSheet.Shapes("AMPM").TextFrame.Characters.Text = "AM" Then PMSel Else: AMSel
End Sub
Sub AMSel()
UnProtTP
With ActiveSheet
.Shapes("AMPM").TextFrame.Characters.Text = "AM"
.Shapes("AMAct").Visible = True
.Shapes("AMInact").Visible = False
.Shapes("PMAct").Visible = False
.Shapes("PMInact").Visible = True
End With
ProtTP
End Sub
Sub PMSel()
UnProtTP
With ActiveSheet
.Shapes("AMPM").TextFrame.Characters.Text = "PM"
.Shapes("AMAct").Visible = False
.Shapes("AMInact").Visible = True
.Shapes("PMAct").Visible = True
.Shapes("PMInact").Visible = False
End With
ProtTP
End Sub

Sub Select1()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("1Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "1"
MinDisplay
End With
ProtTP
End Sub
Sub Select2()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("2Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "2"
If .Shapes("HrsGrp").Visible = True Then MinDisplay
End With
ProtTP
End Sub
Sub Select3()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("3Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "3"
MinDisplay
End With
ProtTP
End Sub
Sub Select4()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("4Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "4"
MinDisplay
End With
ProtTP
End Sub
Sub Select5()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("5Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "5"
MinDisplay
End With
ProtTP
End Sub
Sub Select6()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("6Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "6"
MinDisplay
End With
ProtTP
End Sub
Sub Select7()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("7Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "7"
MinDisplay
End With
ProtTP
End Sub
Sub Select8()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("8Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "8"
MinDisplay
End With
ProtTP
End Sub
Sub Select9()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("9Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "9"
MinDisplay
End With
ProtTP
End Sub
Sub Select10()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("10Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "10"
MinDisplay
End With
ProtTP
End Sub
Sub Select11()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("11Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "11"
MinDisplay
End With
ProtTP
End Sub
Sub Select12()
UnProtTP
HideHrSel
With ActiveSheet
.Shapes("12Sel").Visible = True
.Shapes("HrsDisp").TextFrame.Characters.Text = "12"
MinDisplay
End With
ProtTP
End Sub
Sub SelectM00()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("00MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "00"
End With
ProtTP
End Sub
Sub SelectM05()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("05MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "05"
End With
ProtTP
End Sub
Sub SelectM10()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("10MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "10"
End With
ProtTP
End Sub
Sub SelectM15()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("15MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "15"
End With
ProtTP
End Sub
Sub SelectM20()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("20MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "20"
End With
ProtTP
End Sub
Sub SelectM25()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("25MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "25"
End With
ProtTP
End Sub
Sub SelectM30()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("30MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "30"
End With
ProtTP
End Sub
Sub SelectM35()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("35MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "35"
End With
ProtTP
End Sub
Sub SelectM40()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("40MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "40"
End With
ProtTP
End Sub
Sub SelectM45()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("45MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "45"
End With
ProtTP
End Sub
Sub SelectM50()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("50MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "50"
End With
ProtTP
End Sub
Sub SelectM55()
UnProtTP
HideMinSel
With ActiveSheet
.Shapes("55MSel").Visible = True
.Shapes("MinDisp").TextFrame.Characters.Text = "55"
End With
ProtTP
End Sub

Sub DoneBtn()
With ActiveSheet
    ActiveCell.value = .Shapes("HrsDisp").TextFrame.Characters.Text & ":" & .Shapes("MinDisp").TextFrame.Characters.Text & " " & .Shapes("AMPM").TextFrame.Characters.Text
    .Shapes("TimePickGrp").Visible = False
    'SetHideShow
End With
End Sub

Sub SetHideShow()
With ActiveSheet
UnProtTP
If .Shapes("SetGrp").Visible = False Then
.Shapes("SetGrp").Visible = msoCTrue
Else
.Shapes("SetGrp").Visible = False
End If
End With

ProtTP
End Sub
Sub Set5MinInt()
 With ActiveSheet
    .Shapes("5MinTxt").Fill.ForeColor.RGB = RGB(140, 58, 58)
    .Shapes("5MinTxt").Fill.Visible = msoCTrue
    .Shapes("10MinTxt").Fill.Visible = msoFalse
    .Shapes("15MinTxt").Fill.Visible = msoFalse
 End With
 MinDisplay
 SelectM00
End Sub

Sub Set10MinInt()
 With ActiveSheet
    .Shapes("10MinTxt").Fill.ForeColor.RGB = RGB(140, 58, 58)
    .Shapes("10MinTxt").Fill.Visible = msoCTrue
    .Shapes("5MinTxt").Fill.Visible = msoFalse
    .Shapes("15MinTxt").Fill.Visible = msoFalse
 End With
 MinDisplay
 SelectM00
End Sub

Sub Set15MinInt()
 With ActiveSheet
    .Shapes("15MinTxt").Fill.ForeColor.RGB = RGB(140, 58, 58)
    .Shapes("15MinTxt").Fill.Visible = msoCTrue
    .Shapes("10MinTxt").Fill.Visible = msoFalse
    .Shapes("5MinTxt").Fill.Visible = msoFalse
 End With
 MinDisplay
 SelectM00
End Sub

Sub SetThm1()
ActiveSheet.Shapes.Range(Array("SetBack", "MainBack")).Fill.ForeColor.RGB = RGB(64, 64, 64)
ActiveSheet.Shapes("BackCircle").Fill.ForeColor.RGB = RGB(54, 54, 54)
End Sub
Sub SetThm2()
ActiveSheet.Shapes.Range(Array("SetBack", "MainBack")).Fill.ForeColor.RGB = RGB(55, 96, 146)
ActiveSheet.Shapes("BackCircle").Fill.ForeColor.RGB = RGB(37, 64, 97)
End Sub
Sub SetThm3()
ActiveSheet.Shapes.Range(Array("SetBack", "MainBack")).Fill.ForeColor.RGB = RGB(119, 147, 60)
ActiveSheet.Shapes("BackCircle").Fill.ForeColor.RGB = RGB(79, 98, 40)
End Sub
Sub SetThm4()
ActiveSheet.Shapes.Range(Array("SetBack", "MainBack")).Fill.ForeColor.RGB = RGB(96, 74, 123)
ActiveSheet.Shapes("BackCircle").Fill.ForeColor.RGB = RGB(64, 49, 82)
End Sub
Sub SetThm5()
ActiveSheet.Shapes.Range(Array("SetBack", "MainBack")).Fill.ForeColor.RGB = RGB(49, 133, 156)
ActiveSheet.Shapes("BackCircle").Fill.ForeColor.RGB = RGB(33, 89, 104)
End Sub

Sub UnGrpHrs()
On Error Resume Next
ActiveSheet.Shapes("HrsGrp").Ungroup
On Error GoTo 0
End Sub
Sub GrpHrs()
Dim GrpRange, GrpShapes
On Error GoTo ExitSub
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("1Hr", "2Hr", "3Hr", "4Hr", "5Hr", "6Hr", "7Hr", "8Hr", "9Hr", "10Hr", "11Hr", "12Hr"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "HrsGrp"
ExitSub:
End Sub

Sub UnGrpMin()
On Error Resume Next
ActiveSheet.Shapes("MinGrp").Ungroup
On Error GoTo 0
End Sub
Sub GrpMin()
Dim GrpRange, GrpShapes
On Error GoTo ExitSub
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("00Min", "05Min", "10Min", "15Min", "20Min", "25Min", "30Min", "35Min", "40Min", "45Min", "50Min", "55Min"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "MinGrp"
ExitSub:
End Sub
Sub UnGrpSet()
On Error Resume Next
ActiveSheet.Shapes("SetGrp").Ungroup
ActiveSheet.Shapes("5Thm").Ungroup
ActiveSheet.Shapes("4Thm").Ungroup
ActiveSheet.Shapes("3Thm").Ungroup
ActiveSheet.Shapes("2Thm").Ungroup
ActiveSheet.Shapes("1Thm").Ungroup
ActiveSheet.Shapes("5MinGrp").Ungroup
ActiveSheet.Shapes("10MinGrp").Ungroup
ActiveSheet.Shapes("15MinGrp").Ungroup
On Error GoTo 0
End Sub
Sub GrpSet()
Dim GrpRange, GrpShapes
On Error GoTo ExitSub
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("5Pie1", "5Pie2"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "5Thm"
Set GrpShapes = ActiveSheet.Shapes.Range(Array("4Pie1", "4Pie2"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "4Thm"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("3Pie1", "3Pie2"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "3Thm"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("2Pie1", "2Pie2"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "2Thm"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("1Pie1", "1Pie2"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "1Thm"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("5MinPie", "5MinTxt"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "5MinGrp"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("10MinPie", "10MinTxt"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "10MinGrp"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("15MinPie", "15MinTxt"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "15MinGrp"
 Set GrpShapes = ActiveSheet.Shapes.Range(Array("SetBack", "1Thm", "2Thm", "3Thm", "4Thm", "5Thm", "IntTxt", "ThmTxt", "5MinGrp", "10MinGrp", "15MinGrp"))
      Set GrpRange = GrpShapes.Group
      GrpRange.Name = "SetGrp"
ExitSub:
End Sub
Sub MacroLinkRemover()
'PURPOSE: Remove an external workbook reference from all shapes triggering macros
'Source: www.ExcelForFreelancers.com
Dim shp As Shape
Dim MacroLink, NewLink As String
Dim SplitLink As Variant

  For Each shp In ActiveSheet.Shapes 'Loop through each shape in worksheet
  
    'Grab current macro link (if available)
    On Error GoTo NextShp
      MacroLink = shp.OnAction
    
    'Determine if shape was linking to a macro
      If MacroLink <> "" And InStr(MacroLink, "!") <> 0 Then
        'Split Macro Link at the exclaimation mark (store in Array)
          SplitLink = Split(MacroLink, "!")
        
        'Pull text occurring after exclaimation mark
          NewLink = SplitLink(1)
        
        'Remove any straggling apostrophes from workbook name
            If Right(NewLink, 1) = "'" Then
              NewLink = Left(NewLink, Len(NewLink) - 1)
            End If
        
        'Apply New Link
          shp.OnAction = NewLink
      End If
NextShp:
  Next shp
End Sub

So after I did this I was happy to see that the time picker now works when protecting the sheet!

 

 

Only problem is, the sort arrows in the table headings are no longer selectable. I can't use them. Can someone help? I'm assuming it has something to do with the code. Also, they are not locked, so that's not the problem.

excel
Macros and VBA
No RepliesBe the first to reply

Resources