The following functions are used by the primary functions on this page.
Private Function ArrayElementsInOrder(Arr As Variant, _ Optional Descending As Boolean = False, _ Optional Diff As Integer = 0) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ArrayElementsInOrder ' This function tests an array of integers (Long or Int) to determine ' if they are in order, in ascending or descending sort order, and ' optionally if they all differ by exactly Diff. Diff is the absolute ' value between two adjacent elements. Do not use a negative number ' for a descending sort; Diff should always be greater than 0 to test ' the differences or 0 to ignore differences. The default behavior ' is to test whether the elements are in ascending order with any ' difference between them. Set the Descending and/or Diff parameters ' to change this. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim N As Long For N = LBound(Arr) To UBound(Arr) - 1 If Descending = False Then If Diff > 0 Then If Arr(N) <> Arr(N + 1) - Diff Then ArrayElementsInOrder = False Exit Function End If Else If Arr(N) > Arr(N + 1) Then ArrayElementsInOrder = False Exit Function End If End If Else If Diff > 0 Then If Arr(N) <> Arr(N + 1) + Diff Then ArrayElementsInOrder = False Exit Function End If Else If Arr(N) < Arr(N + 1) Then ArrayElementsInOrder = False Exit Function End If End If End If Next N ArrayElementsInOrder = True End Function Private Function TestFirstLastSort(FirstToSort As Long, LastToSort As Long, _ ByRef ErrorText As String) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' TestFirstLastSort ' This ensures FirstToSort and LastToSort are valid values. If successful, ' returns True and sets ErrorText to vbNullString. If unsuccessful, returns ' False and set ErrorText to the reason for failure. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ErrorText = vbNullString If FirstToSort <= 0 Then TestFirstLastSort = False ErrorText = "FirstToSort is less than or equal to 0." Exit Function End If If FirstToSort > Worksheets.Count Then TestFirstLastSort = False ErrorText = "FirstToSort is greater than number of sheets." Exit Function End If If LastToSort <= 0 Then TestFirstLastSort = False ErrorText = "LastToSort is less than or equal to 0." Exit Function End If If LastToSort > Worksheets.Count Then TestFirstLastSort = False ErrorText = "LastToSort greater than number of sheets." Exit Function End If If FirstToSort > LastToSort Then TestFirstLastSort = False ErrorText = "FirstToSort is greater than LastToSort." Exit Function End If TestFirstLastSort = True End Function Private Function IsArrayAllocated(Arr As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsArrayAllocated ' Returns True or False indicating if Arr is an allocated ' array. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next Dim V As Variant IsArrayAllocated = True V = Arr(LBound(Arr, 1)) If IsError(V) = True Then IsArrayAllocated = False End If If (UBound(Arr, 1) < LBound(Arr, 1)) Then IsArrayAllocated = False End If End Function Private Function SheetExists(WSName As String, Optional WB As Workbook = Nothing) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' SheetExists ' Returns True if worksheet named by WSName exists in ' Workbook WB. If WB is omitted, ' the ActiveWorkbook is used. '''''''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next SheetExists = IsError(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName)) = False End Function
No comments:
Post a Comment