Converting Cell Value To Array

T

travelingwilly

New Member
Joined
Jun 19, 2002
Messages
24
How can I change one cell Value to A MultiDimenional Array

.cells(1,1).value ..=
"0, 2,10, 2, 40, 9, 52, 9,64, 9,75, 9,88, 1"

Convert to
arr(1 to 2, 1 to 5)
or
0,2
10,2
40,9
52,9
64,9
75,9
88,1

???
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Hi,

Here is one way to do it. This assumes that commas are the separator. Eventually, it writes the results into a 2D array called CellArray()

Code: 
Sub test()
Dim v As Integer, w As Integer, x As String, y As Integer
Dim z As Integer, a As Integer
Dim fn As WorksheetFunction
Dim CellArray, CommaPos, TempArray

Set fn = Application.WorksheetFunction

With Sheets("Sheet1")
x = .Cells(1, 1)
End With

y = Len(x) - Len(fn.Substitute(x, ",", ""))
If y Mod 2 = 0 Then
    MsgBox "Uneven Pairing"
    Exit Sub
End If
z = (y + 1) / 2
ReDim TempArray(1 To y + 1)
ReDim CommaPos(1 To y)
ReDim CellArray(1 To z, 1 To 2)

For v = 1 To y
    If v = 1 Then
        CommaPos(v) = fn.Search(",", x)
        TempArray(v) = Left(x, CommaPos(v) - 1)
    Else
        CommaPos(v) = fn.Search(",", x, CommaPos(v - 1) + 1)
        TempArray(v) = Mid(x, CommaPos(v - 1) + 1, CommaPos(v) - CommaPos(v - 1) - 1)
    End If
Next v
        TempArray(y + 1) = Right(x, Len(x) - CommaPos(y))


For w = 1 To y + 1
    If w Mod 2 = 1 Then
        a = w  2 + 1
        CellArray(a, 1) = TempArray(w)
    Else
        a = w  2
        CellArray(a, 2) = TempArray(w)
    End If
Next w

End Sub

Bye,
Jay

EDIT: The calculation for the variable a in the last loop should only have one backslash, not two. Also, with some modification, I think that second loop can be discarded, but please test this out before we make it more efficient (it should run instantly even now).
This message was edited by Jay Petrulis on 2002-06-23 18:52
 
Upvote 0
It almost Works is seems to load and create the spread sheet. But Once doneI get an excel error report occurs and excel is dropped. Can anyone see the problem ...

Sub test()
Dim v As Integer, w As Integer, x As String, y As Integer
Dim z As Integer, a As Integer
Dim fn As WorksheetFunction
Dim CellArray, CommaPos, TempArray

Set fn = Application.WorksheetFunction

' Sheets("Input Format").Cells(2, 7) = "0, 2,10, 2, 40, 9, 52, 9,64, 9,75, 9,88, 1"

x = Sheets("Input Format").Cells(2, 7)


y = Len(x) - Len(fn.Substitute(x, ",", ""))
If y Mod 2 = 0 Then
MsgBox "Uneven Pairing"
Exit Sub
End If
z = (y + 1) / 2
ReDim TempArray(1 To y + 1)
ReDim CommaPos(1 To y)
ReDim CellArray(1 To z, 1 To 2)

For v = 1 To y
If v = 1 Then
CommaPos(v) = fn.Search(",", x)
TempArray(v) = Left(x, CommaPos(v) - 1)
Else
CommaPos(v) = fn.Search(",", x, CommaPos(v - 1) + 1)
TempArray(v) = Mid(x, CommaPos(v - 1) + 1, CommaPos(v) - CommaPos(v - 1) - 1)
End If
Next v
TempArray(y + 1) = Right(x, Len(x) - CommaPos(y))


For w = 1 To y + 1
If w Mod 2 = 1 Then
a = w 2 + 1
CellArray(a, 1) = TempArray(w)
Else
a = w 2
CellArray(a, 2) = TempArray(w)
End If
Next w

Fillnm = Application.GetOpenFilename(Filefilter:="Report Doc(*.doc),*.doc", Title:=Reprt + " Report")

'Workbooks.OpenText Filename:=Fillnm, _
' Origin:=xlWindows, StartRow:=RptStart, DataType:=xlFixedWidth, FieldInfo:= _
' Array(Array(0, 2), Array(10, 2), Array(40, 9), Array(52, 9), Array(64, 9), Array(75, 9), Array(88, 1))

Workbooks.OpenText Filename:=Fillnm, _
Origin:=xlWindows, StartRow:=8, DataType:=xlFixedWidth, FieldInfo:=CellArray

End Sub
 
Upvote 0
Ah, I see what you are doing with CellArray. Pretty cool. I suppose that it bombs on the last line, correct?

Workbooks.OpenText Filename:=Fillnm, _
Origin:=xlWindows, StartRow:=8, DataType:=xlFixedWidth, FieldInfo:=CellArray

I think this line is causing problems for you, but correct me if I am wrong.

I think the issue is that you have the CellArray array working correctly, but you need an Array(CellArray(x,y)) part, possibly in a loop.

Very interesting...let me see if I can figure this out.

Bye,
Jay
 
Upvote 0
That is correct, It is blowing up at the opentext statement. But I actually see it creating the spreadsheet But when done it blows Excel reports an error and blows up. And dumps the whole excel application.
 
Upvote 0
Figured it out..... Stupid little thing

I had to force the value into an integer. Works great

For w = 1 To y + 1
If w Mod 2 = 1 Then
a = w 2 + 1
CellArray(a, 1) = Cint(TempArray(w))
Else
a = w 2
CellArray(a, 2) = Cint(TempArray(w))
End If
Next w
 
Upvote 0
Hi,

You can also set the data type as Integer in the ReDim CellArray() statement.

I have reposted the code with a few changes.
1. TempArray has been removed
2. The second loop has been removed, too.

Code: 
Sub test2()
Dim v As Integer, x As String, y As Integer
Dim z As Integer, a As Integer
Dim fn As WorksheetFunction
Dim CellArray, CommaPos

Set fn = Application.WorksheetFunction

With Sheets("Input Format")
x = .Cells(2, 7)
End With

y = Len(x) - Len(fn.Substitute(x, ",", ""))
If y Mod 2 = 0 Then
    MsgBox "Uneven Pairing"
    Exit Sub
End If
z = (y + 1) / 2
ReDim CommaPos(1 To y)
ReDim CellArray(1 To z, 1 To 2) As Integer

For v = 1 To y
    If v Mod 2 = 1 Then
        a = v  2 + 1
            If v = 1 Then
                CommaPos(v) = fn.Search(",", x)
                CellArray(a, 1) = Left(x, CommaPos(v) - 1)
            Else
                CommaPos(v) = fn.Search(",", x, CommaPos(v - 1) + 1)
                CellArray(a, 1) = Mid(x, CommaPos(v - 1) + 1, CommaPos(v) - CommaPos(v - 1) - 1)
            End If
    Else
        a = v  2
            If v = 1 Then
                CommaPos(v) = fn.Search(",", x)
                CellArray(a, 2) = Left(x, CommaPos(v) - 1)
            Else
                CommaPos(v) = fn.Search(",", x, CommaPos(v - 1) + 1)
                CellArray(a, 2) = Mid(x, CommaPos(v - 1) + 1, CommaPos(v) - CommaPos(v - 1) - 1)
            End If
    End If
Next v
CellArray(z, 2) = Right(x, Len(x) - CommaPos(y))


''''rest of your code
End Sub

Please note that only one forward slash should be there in the calculation of the 'a' variable.

Bye,
Jay
This message was edited by Jay Petrulis on 2002-06-28 16:08
 
Upvote 0
Hi
You could also make use of the Split-function
like this.

Dim x As String
Dim t As Variant
Dim i As Integer, ubt As Integer, z As Integer
t = Split([a1].Value, ",")
ubt = UBound(t)
If ubt Mod 2 = 0 Then
MsgBox ("Uneven")
Exit Sub
End If
z = 0
ReDim cellarray((ubt + 1) 2, 1)
For i = 0 To ubt Step 2
cellarray(z, 0) = Val(t(i))
cellarray(z, 1) = Val(t(i + 1))
z = z + 1
Next


regards Tommy
 
Upvote 0
Thanks ..

Dim x As String, t As Variant
Dim i As Integer, z As Integer, NumUbnd As Integer

t = Split(Sheets("Input Format").Cells(Linee, :cool:.Value, ",")
NumUbnd = UBound(t)
If NumUbnd Mod 2 = 0 Then
MsgBox ("UnEven Format Found Try Please Correct")
Exit Sub
End If
z = 0
ReDim FieldInfoArr((NumUbnd) 2, 1)
For i = 0 To NumUbnd Step 2
FieldInfoArr(z, 0) = Val(t(i))
FieldInfoArr(z, 1) = Val(t(i + 1))
z = z + 1
Next


Works Great. 2 ways to look at it and the Split is perfect. Thanks
 
Upvote 0
Hi,

The Split function was introduced in Excel 2000. If any users have Excel 97, the Split option won't work, although I have seen a few UDFs with a Split equivalent.

Nice work on this. I never knew of the Split function before Tommy's post. Makes the job much easier, for sure.

Bye,
Jay
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Offset Processes
Replies
7
Views
271
SanjayGMusafir
SanjayGMusafir
S
  • Question
"Subscript out of range ( Run time Error: 09)" Problem in My Excel VBA
Replies
5
Views
272
6StringJazzer
6StringJazzer
B
  • Question
Add new Row in ListObject Table with data from an Array
Replies
4
Views
93
Akuini
Akuini
S
  • Solved
Formula or VBA for Cell Range of Values
2
Replies
17
Views
300
Eric W
Eric W
JeffGrant
  • Solved
Array output - very very strange - I am a complete loss
Replies
4
Views
337
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,029
Messages
6,122,755
Members
449,094
Latest member
dsharae57

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top