View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Get a color name from any RGB combination?

Charlotte, try this on the dataset.js file 'as is'...

Option Explicit

Sub ConvertColorData()
Dim vTextIn, v1, v2, vTextOut, sTmp$
Dim n&, k&, i&
sTmp = ReadTextFile("C:\Users\Garry\Documents\VBA_Stuff\d ataset.js")
'Replace "}," with "|" as the line delimiter
sTmp = Replace(sTmp, "},", "|")
'Filter out unwanted characters
vTextIn = Split(FilterString(sTmp, ",:|"), "|")
'Store the data in a normal csv file
WriteTextFile Join(vTextIn, vbLf), _
"C:\Users\Garry\Documents\VBA_Stuff\dataset.tx t"

ReDim vTextOut(1 To UBound(vTextIn) + 1, 1 To 4)
For n = LBound(vTextIn) To UBound(vTextIn)
v1 = Split(vTextIn(n), ",")
For k = LBound(v1) To UBound(v1)
v2 = Split(v1(k), ":")
vTextOut(n + 1, k + 1) = v2(1)
Next 'k
Next 'n
Cells(1, 1).Resize(UBound(vTextOut), UBound(vTextOut, 2)) = vTextOut
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Function FilterString$(ByVal TextIn As String, _
Optional IncludeChars As String, _
Optional IncludeLetters As Boolean = True, _
Optional IncludeNumbers As Boolean = True)
' Filters out all unwanted characters in a string.
' Arguments: TextIn The string being filtered.
' IncludeChars [Optional] Keeps any characters.
' IncludeLetters [Optional] Keeps any letters.
' IncludeNumbers [Optional] Keeps any numbers.
'
' Returns: String containing only the wanted characters.

Const sSource As String = "FilterString()"

'The basic characters to always keep
Const sLetters As String = "abcdefghijklmnopqrstuvwxyz"
Const sNumbers As String = "0123456789"

Dim i As Long, CharsToKeep As String

CharsToKeep = IncludeChars
If IncludeLetters Then _
CharsToKeep = CharsToKeep & sLetters & UCase(sLetters)
If IncludeNumbers Then CharsToKeep = CharsToKeep & sNumbers

For i = 1 To Len(TextIn)
If InStr(CharsToKeep, Mid$(TextIn, i, 1)) Then _
FilterString = FilterString & Mid$(TextIn, i, 1)
Next
End Function 'FilterString()

Sub WriteTextFile(TextOut$, Filename$, Optional AppendMode As Boolean =
False)
' Reusable procedure that Writes/Overwrites or Appends
' large amounts of data to a Text file in one single step.
' **Does not create a blank line at the end of the file**
Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & TextOut;
Else
Open Filename For Output As #iNum: Print #iNum, TextOut;
End If

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFile()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion