Moving Sheet Groups within a Workbook

Aug15
by on August 15, 2016 at 12:38 pm
Posted In: Around the Web, Keyboard

Last week I created a keyboard shortcut to move a sheet within a workbook. This week I’m changing it to work with groups of sheets rather than just the active sheet. Not because I need it. I rarely work with grouped sheets as it is. But sometimes you have to program just for the fun of it.

This will require a change to NextVisibleSheetIndex function. I tried to determine if the ActiveSheet was in a group and where it was in the group. That resulted in some inelegant code and I could tell I was doing it wrong. Then I realized that I should stop futzing with the ActiveSheet and just pass a sheet into the function where I want to start. That made things much simpler.

Public Function NextVisibleSheetIndex(ByRef shStart As Object, ByVal bDown As Boolean) As Long
   
    Dim lReturn As Long
    Dim i As Long
   
    If bDown Then
        For i = shStart.Index + 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Visible Then
                lReturn = i
                Exit For
            End If
        Next i
    Else
        For i = shStart.Index – 1 To 1 Step -1
            If ActiveWorkbook.Sheets(i).Visible Then
                lReturn = i
                Exit For
            End If
        Next i
    End If
   
    NextVisibleSheetIndex = lReturn
   
End Function

That kept the function code cleaner, but I still had to figure out what sheet to pass in. Well, that turned out to be really easy. If It was moving left, I pass in the first sheet in the group.

Sub MoveSheetsUp()
   
    Dim ssh As Sheets
   
    Set ssh = ActiveWindow.SelectedSheets
   
    If ssh(1).Index = FirstVisibleSheetIndex Then
        If Timer – msnLastWrap > msnWRAPBUFFER Then
            gclsAppEvents.AddLog "^%{PGUP}", "MoveSheetsUp"
            ssh.Move , ActiveWorkbook.Sheets(LastVisibleSheetIndex)
        End If
    Else
        ssh.Move ActiveWorkbook.Sheets(NextVisibleSheetIndex(ssh(1), False))
    End If
   
    msnLastWrap = Timer
   
End Sub

And if I’m moving right, I pass in the last sheet.

Sub MoveSheetsDown()
   
    Dim ssh As Sheets
   
    Set ssh = ActiveWindow.SelectedSheets
   
    If ssh(ssh.Count).Index = LastVisibleSheetIndex Then
        If Timer – msnLastWrap > msnWRAPBUFFER Then
            gclsAppEvents.AddLog "^%{PGDN}", "MoveSheetsDown"
            ssh.Move ActiveWorkbook.Sheets(FirstVisibleSheetIndex)
        End If
    Else
        ssh.Move , ActiveWorkbook.Sheets(NextVisibleSheetIndex(ssh(ssh.Count), True))
    End If
   
    msnLastWrap = Timer
   
End Sub
└ Tags: