View Single Post
 
Old 02-15-2005, 02:04 AM
Flyguy's Avatar
Flyguy Flyguy is offline
Lost Soul

Super Moderator
* Guru *
 
Join Date: May 2001
Location: Vorlon
Posts: 19,164
Default

An updated version of CompareValues function to take in account Numeric/Date values:
Code:
'--------------------------------------------------------------------------------------- ' Procedure : CompareValues ' DateTime : 27-12-2004 ' Author : Flyguy ' Purpose : Compare column values for multicolumn sorting ' Revision : 15-02-2005, take in account numeric and date values '--------------------------------------------------------------------------------------- Private Function CompareValues(ByRef sArray() As String, lIndex1 As Long, _ lIndex2 As Long, lNofColumns As Long, aColumns() As Long, aOrder() As Long) Dim i As Long Dim lCol As Long Dim sValue1 As String, sValue2 As String Dim dValue1 As Double, dValue2 As Double Dim bNumeric As Boolean For i = 1 To lNofColumns lCol = aColumns(i) If aOrder(i) = 1 Then sValue1 = sArray(lIndex1, lCol) sValue2 = sArray(lIndex2, lCol) Else sValue1 = sArray(lIndex2, lCol) sValue2 = sArray(lIndex1, lCol) End If If IsDate(sValue1) And IsDate(sValue2) Then dValue1 = CDate(sValue1) dValue2 = CDate(sValue2) bNumeric = True ElseIf IsNumeric(sValue1) And IsNumeric(sValue2) Then dValue1 = CDbl(sValue1) dValue2 = CDbl(sValue2) bNumeric = True Else bNumeric = False End If If bNumeric Then If dValue1 < dValue2 Then Exit For ElseIf dValue1 > dValue2 Then CompareValues = True Exit For End If Else If sValue1 < sValue2 Then Exit For ElseIf sValue1 > sValue2 Then CompareValues = True Exit For End If End If Next i End Function
Reply With Quote