Hi there,
Take a look at the attached version of your workbook and see if it does what you need.
The big disadvantage of your original version is that (because values are stored in an array) the list of completed shortcuts is not "remembered" between sessions - i.e. every time the workbook is opened, the entire list of shortcuts is presented. The attached version stores values in a worksheet range so that they are "remembered" between sessions.
Another change is that when scrolling forwards, the list of shortcuts scrolls from the last item in the list to the first item; likewise when scrolling backwards, the list scrolls from the first item to the last item. In either case, those shortcuts which have been marked as completed do not appear in the list of available shortcuts.
There was quite a bit of rewriting to do, but it was an interesting project! 
The attached workbook uses the following code:
Option Explicit
'=========================================================================================
'=========================================================================================
Const miNO_OF_SHORTCUTS__EXCEL As Integer = 76
Const miNO_OF_SHORTCUTS__VBA As Integer = 99
Const msHEADER_EXCEL As String = "ptrHeader_Excel"
Const msHEADER_VBA As String = "ptrHeader_VBA"
Const msEXCEL As String = "Excel"
Const msVBA As String = "VBA"
'=========================================================================================
'=========================================================================================
Private mbEventsAreEnabled As Boolean
'=========================================================================================
'=========================================================================================
Private Sub UserForm_Initialize()
With Me
' Note: This value must be set BEFORE the ListIndex property is set below
txtShortcutNo.Value = 0
lstContext.AddItem msVBA
lstContext.AddItem msEXCEL
lstContext.ListIndex = 0
End With
mbEventsAreEnabled = True
End Sub
'=========================================================================================
'=========================================================================================
Private Sub lstContext_Click()
Me.txtShortcutNo.Value = 0
Call btnNext_Click
End Sub
'=========================================================================================
'=========================================================================================
Private Sub btnNext_Click()
Call ChangeShortcutNo(iIncrement:=1)
End Sub
'=========================================================================================
'=========================================================================================
Private Sub btnPrevious_Click()
Call ChangeShortcutNo(iIncrement:=-1)
End Sub
'=========================================================================================
'=========================================================================================
Private Sub chkCompleted_Click()
Dim rLastCell As Range
If mbEventsAreEnabled = True Then
If lstContext.Value = msVBA Then
Set rLastCell = wksCompleted.Range(msHEADER_VBA)
Else: Set rLastCell = wksCompleted.Range(msHEADER_EXCEL)
End If
If rLastCell.Offset(1, 0).Value <> vbNullString Then
Set rLastCell = rLastCell.End(xlDown)
End If
If Me.chkCompleted.Value = True Then
Set rLastCell = rLastCell.Offset(1, 0)
rLastCell.Value = Me.txtShortcutNo.Value
Else: rLastCell.ClearContents
End If
End If
End Sub
'=========================================================================================
'=========================================================================================
Private Sub btnReset_Click()
Dim iNoOfShortcuts As Integer
Dim iUserResponse As Integer
Dim rHeaderCell As Range
Dim sContext As String
sContext = Me.lstContext.Value
If sContext = msEXCEL Then
iNoOfShortcuts = miNO_OF_SHORTCUTS__EXCEL
Set rHeaderCell = wksCompleted.Range(msHEADER_EXCEL)
Else: iNoOfShortcuts = miNO_OF_SHORTCUTS__VBA
Set rHeaderCell = wksCompleted.Range(msHEADER_VBA)
End If
iUserResponse = MsgBox("This will unselect all of the " & sContext & _
" Shortcuts marked as ""Completed""" & _
vbLf & vbLf & _
"Are you sure you wish to continue?", _
vbYesNo + vbDefaultButton2, " Confirm operation")
If iUserResponse = vbYes Then
With rHeaderCell.Offset(1, 0)
Range(.Cells(1, 1), _
.Cells(iNoOfShortcuts)).ClearContents
End With
Me.txtShortcutNo.Value = 0
Call btnNext_Click
End If
End Sub
'=========================================================================================
'=========================================================================================
Private Sub ChangeShortcutNo(iIncrement As Integer)
Dim iLastShortcutNo As Integer
Dim rCompletedCells As Range
Dim rCompletedCell As Range
Dim iShortcutNo As Integer
Dim rHeaderCell As Range
If Me.chkCompleted.Value = True Then
mbEventsAreEnabled = False
Me.chkCompleted.Value = False
mbEventsAreEnabled = True
End If
With wksCompleted
If lstContext.Value = msVBA Then
Set rHeaderCell = .Range(msHEADER_VBA)
iLastShortcutNo = miNO_OF_SHORTCUTS__VBA
Else: Set rHeaderCell = .Range(msHEADER_EXCEL)
iLastShortcutNo = miNO_OF_SHORTCUTS__EXCEL
End If
With rHeaderCell
Set rCompletedCells = Range(.Cells(2, 1), _
.Cells(iLastShortcutNo + 1, 1))
End With
iShortcutNo = Me.txtShortcutNo.Value
Do
iShortcutNo = iShortcutNo + iIncrement
If iShortcutNo > iLastShortcutNo Then
iShortcutNo = 1
ElseIf iShortcutNo = 0 Then
iShortcutNo = iLastShortcutNo
End If
Set rCompletedCell = rCompletedCells.Cells.Find(What:=iShortcutNo, _
LookIn:=xlValues, _
LookAt:=xlWhole)
Loop While Not rCompletedCell Is Nothing
Me.txtShortcutNo.Value = iShortcutNo
Call UpdateShortcutDetails
End With
End Sub
'=========================================================================================
'=========================================================================================
Private Sub UpdateShortcutDetails()
Const sCOLUMN_HELP As String = "C"
Const sCOLUMN_KEY As String = "B"
Const sCOLUMN_NO As String = "A"
Dim iShortcutNo As Integer
Dim wks As Worksheet
If Me.lstContext.Value = msVBA Then
Set wks = wksVBA
Else: Set wks = wksExcel
End If
iShortcutNo = Me.txtShortcutNo.Value
If iShortcutNo > 0 Then
txtShortcutNo.Value = wks.Range(sCOLUMN_NO & iShortcutNo).Value
txtShortcutKey.Value = wks.Range(sCOLUMN_KEY & iShortcutNo).Value
txtShortcutHelp.Value = wks.Range(sCOLUMN_HELP & iShortcutNo).Value
End If
End Sub
The highlighted values should be altered appropriately if shortcuts are added to or deleted from the lists.
Hope this helps - please let me know how you get on.
Regards,
Greg M
LinkBack URL
About LinkBacks
dmcgov 
Register To Reply
Bookmarks