Alternative to Split function for Excel97?

[Guest]

I am using Excel XP at home but have transfered a spreadsheet to a PC which
has Excel 97 on it. I can't update this PC. I have used the Split function in
a macro, this isn't recognised in 97. Are there any alternatives?

 

[Norman Jones]

Hi Norm,

Try Tom Ogilvy's Split97 function:

Function Split97(sStr As String, sDelim As String) As Variant
Split97 = Evaluate("{""" & Application.Substitute _
(sStr, sDelim, """,""") & """}")
End Function

 

[Tom Ogilvy]

Note that this returns a 1 based array while the normal split function
returns a 0 based array. Also, while "clever" <g>, this is limited by the
size of the string it can handle.

KeepItCool posted this routine to list printers, but it includes a more
generalized split function he wrote and shows how you can include it in your
code using conditional compilation: (so the normal split function is used in
Excel 2000 and later).

Newsgroups: microsoft.public.excel.programming
Subject: Re: COMBOBOX WITH PRINTERS LIST
From: keepitcool <[email protected]>
References: <[email protected]>
Organization: xlSupport.com
Message-ID: <[email protected]>
User-Agent: Xnews/5.04.25
Lines: 119
Date: Wed, 26 May 2004 06:45:47 GMT
NNTP-Posting-Host: 24.132.231.213
X-Complaints-To: (e-mail address removed)
X-Trace: amsnews02.chello.com 1085553947 24.132.231.213 (Wed, 26 May 2004
08:45:47 MEST)
NNTP-Posting-Date: Wed, 26 May 2004 08:45:47 MEST


Christian..

the function below returns an array of the installed printers
( in complete localized strings)
Can be called when you're filling a combobox on a form or in a dropdown
from worksheet as in demo (as in the demo)

Sub Demo()
Dim v As Variant
Dim i As Long
Workbooks.Add xlWBATWorksheet
v = PrinterList
For i = LBound(v) To UBound(v)
Cells(i + 1, 1) = v(i)
Cells(i + 1, 2).Formula = "=printerlist(" & i & ")"
Next
Cells(1, 3).Resize(i, 1).FormulaArray = "=transpose(printerlist())"
Cells(1, 4).Resize(1, i).FormulaArray = "=printerlist()"
Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
MsgBox Join(v, vbNewLine)
End Sub


Function PrinterList(Optional PrinterNr As Integer = -1)
Dim i%, n%, lRet&, sBuf$, sOn$, sPort$, aPrn
Const lSize& = 1024, sKey$ = "devices"

'-----------------------------------------------------------
'Author: keepITcool 1st posted nl.office.excel 23/10/2003
'Function returns a zerobased array of installed printers
'include for xl97: supplemental functions split/join/replace
'-----------------------------------------------------------

'Get localized Connection string
aPrn = Split(Excel.ActivePrinter)
sOn = " " & aPrn(UBound(aPrn) - 1) & " "
'Read Printers
sBuf = Space(lSize)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lSize)
If lRet = 0 Then Exit Function
'Make Array from String
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
'Add Port for each Printer
For n = LBound(aPrn) To UBound(aPrn)
sBuf = Space(lSize)
lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lSize)
sPort = Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ","))
aPrn(n) = aPrn(n) & sOn & sPort
Next
'Sort
qSort aPrn
'Return the results
If PrinterNr = -1 Then PrinterList = aPrn Else PrinterList = aPrn( _
PrinterNr)
End Function


Public Sub qSort(v, Optional n& = True, Optional m& = True)
Dim i&, j&, p, t
If n = True Then n = LBound(v): If m = True Then m = UBound(v)
i = n: j = m: p = v((n + m) \ 2)
While (i <= j)
While (v(i) < p And i < m): i = i + 1: Wend
While (v(j) > p And j > n): j = j - 1: Wend
If (i <= j) Then
t = v(i): v(i) = v(j): v(j) = t
i = i + 1: j = j - 1
End If
Wend
If (n < j) Then qSort v, n, j
If (i < m) Then qSort v, i, m
End Sub

'**********************************************************
' Optional Split function for xl97
'**********************************************************
#If VBA6 Then
#Else

Function Split(sText As String, _
Optional sDelim As String = " ") As Variant
Dim i%, sFml$, v0, v1
Const sDQ$ = """"

If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") & """}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next

Split = v0

End Function
#End If

keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Charles Williams]

Here is the routine I use, adapted from one found at VBSPEED
(http://www.xbeat.net/vbspeed/c_Split.htm
Its fast enough not to bother with VBA6 split.


Public Function Split5(Expression As String, _
Delimiter As String) As Variant
' by Donald, (e-mail address removed), 20000916
'
' modified for VBA5 crw 8/10/2004
'
'
Const BUFFERDIM As Long = 1024
Dim cntSplit As Long
Dim posStart As Long
Dim posFound As Long
Dim lenDelimiter As Long
Dim sArray() As String
Dim ubArray As Long
Dim Count As Long

Count = -1

lenDelimiter = Len(Delimiter)
If lenDelimiter = 0 Then
' return expression in single-element Variant array
Split5 = Array(Expression)
Else
posStart = 1
ubArray = -1
Do
If cntSplit > ubArray Then
ubArray = ubArray + BUFFERDIM
ReDim Preserve sArray(ubArray)
End If
posFound = InStr(posStart, Expression, Delimiter, vbBinaryCompare)
If cntSplit + 1 = Count Then
sArray(cntSplit) = Mid$(Expression, posStart)
Exit Do
Else
If posFound Then
sArray(cntSplit) = Mid$(Expression, posStart, posFound -
posStart)
posStart = posFound + lenDelimiter
cntSplit = cntSplit + 1
Else
sArray(cntSplit) = Mid$(Expression, posStart)
End If
End If
Loop While posFound
' shrink to actual size
ReDim Preserve sArray(cntSplit)
' return string array as Variant array
Split5 = sArray
End If

End Function


regards
Charles
______________________
Decision Models
FastExcel 2.1 now available
www.DecisionModels.com

 

[Jim Cone]

Charles,
I give up...

Count = -1
If cntSplit + 1 = Count Then

How could cntSplit ever = -2?
Is this some "left over" code?

Regards,
Jim Cone
San Francisco, CA

 

[Dave Peterson]

And MS has some code at:

http://support.microsoft.com/default.aspx?scid=kb;en-us;188007
HOWTO: Simulate Visual Basic 6.0 String Functions in VB5

 

[Charles Williams]

Jim,

the original VBSPEED routine has an optional Count argument (VB6 Split has
this optional argument) which I removed when converting to VBA5, but I added
Count=-1 instead of the default value for the optional argument ...

Charles
______________________
Decision Models
FastExcel 2.1 now available
www.DecisionModels.com