ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Writing array to a range (https://www.excelbanter.com/excel-programming/451305-writing-array-range.html)

[email protected]

Writing array to a range
 
I am populating array from a text file from some code I found online. The plan then is to extract the array to a range. The problem is it is not working correctly. The output to the range is sideways for 8 columns and 9 rows but then the rest of it is #N/A.

The text file is 8 columns (comma delimited) by about 170000 rows.

Here is what I have so far. I am fairly certain that the problem is at the bottom where the array is assigned to the range.

Sub DelimitedTextFileToArray()
'PURPOSE: Load an Array variable with data from a delimited text file
'SOURCE: www.TheSpreadsheetGuru.com

Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As Variant 'String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As Variant
Dim TempArray() As String
Dim rw As Long, col As Long

Application.StatusBar = False


FilePath = Application.GetOpenFilename(FileFilter:="Text File (*.txt),*..txt")
If FilePath = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If


Delimiter = ","

'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile

'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)

'Close Text File
Close TextFile

'Separate Out lines of data
LineArray() = Split(FileContent, vbCrLf)

'Read Data into an Array Variable
For x = LBound(LineArray) To UBound(LineArray)
If Len(Trim(LineArray(x))) < 0 Then

'Split up line of text by delimiter
TempArray = Split(LineArray(x), Delimiter)

'Determine how many columns are needed
col = UBound(TempArray)

'Re-Adjust Array boundaries
ReDim Preserve DataArray(col, rw)

'Load line of data into Array variable
For y = LBound(TempArray) To UBound(TempArray)
DataArray(y, rw) = TempArray(y)

Next y
End If

'Next line
rw = rw + 1



Next x

Dim Destination As Range
Set Destination = Range("a1")

Destination.Resize(UBound(DataArray, 2), UBound(DataArray, 1)).Value = DataArray




End Sub

Peter T[_7_]

Writing array to a range
 
Looks like you've got your rows and columns mixed up, not tested but change
these bits

'Determine how many columns are needed
col = UBound(TempArray)
If col maxCol Then
maxCol = col
'Re-Adjust Array boundaries
ReDim Preserve DataArray(UBound(LineArray), col)
End If

'Load line of data into Array variable
For y = LBound(TempArray) To UBound(TempArray)
DataArray(x, y) = TempArray(y)
Next y

Destination.Resize(UBound(DataArray) - LBound(DataArray) + 1, _
UBound(DataArray, 2) - LBound(DataArray, 2) + 1) = DataArray

Apart from that there are assumptions about the textfile that might throw
things if not as expected

Regards,
Peter T


wrote in message
...
I am populating array from a text file from some code I found online. The
plan then is to extract the array to a range. The problem is it is not
working correctly. The output to the range is sideways for 8 columns and 9
rows but then the rest of it is #N/A.

The text file is 8 columns (comma delimited) by about 170000 rows.

Here is what I have so far. I am fairly certain that the problem is at the
bottom where the array is assigned to the range.

Sub DelimitedTextFileToArray()
'PURPOSE: Load an Array variable with data from a delimited text file
'SOURCE: www.TheSpreadsheetGuru.com

Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As Variant 'String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As Variant
Dim TempArray() As String
Dim rw As Long, col As Long

Application.StatusBar = False


FilePath = Application.GetOpenFilename(FileFilter:="Text File
(*.txt),*.txt")
If FilePath = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If


Delimiter = ","

'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile

'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)

'Close Text File
Close TextFile

'Separate Out lines of data
LineArray() = Split(FileContent, vbCrLf)

'Read Data into an Array Variable
For x = LBound(LineArray) To UBound(LineArray)
If Len(Trim(LineArray(x))) < 0 Then

'Split up line of text by delimiter
TempArray = Split(LineArray(x), Delimiter)

'Determine how many columns are needed
col = UBound(TempArray)

'Re-Adjust Array boundaries
ReDim Preserve DataArray(col, rw)

'Load line of data into Array variable
For y = LBound(TempArray) To UBound(TempArray)
DataArray(y, rw) = TempArray(y)

Next y
End If

'Next line
rw = rw + 1



Next x

Dim Destination As Range
Set Destination = Range("a1")

Destination.Resize(UBound(DataArray, 2), UBound(DataArray, 1)).Value =
DataArray




End Sub



[email protected]

Writing array to a range
 
Thanks so much - it now works. And yes there are some assumptions about the text files but that is okay since there is no variation between them.

[email protected]

Writing array to a range
 
I have one other question related to this. If I only wanted to retain the rows in which there was a certain value within it how would that be done? Make a sub array (from the main array) of the rows that contain this value and then send this to a range on a worksheet.

David

Peter T[_7_]

Writing array to a range
 

wrote in message
...
I have one other question related to this. If I only wanted to retain the
rows in which there was a certain value within it how would that be done?
Make a sub array (from the main array) of the rows that contain this value
and then send this to a range on a worksheet.


Something like-

If Len(Trim(LineArray(x))) = 0 Then
' do nothing
Elseif Instr(1, LineArray(x), "abc") Then ' keep rows that contain abc
rw = rw + 1
add to the main array after redim preserve if/as necessary, not in row-x
(the loop counter) as I gave last time but in row-rw

After the loop the main array might have empty rows, so resize the range to
size of the array that's been populated

Destination.Resize(rw, maxCol + 1).value = DataArray


Note LBound in both dimensions of the main array is probably zero, 'rw' is
presumably the actual count but maxCol is probably the count including zero,
hence maxCol + 1. As written above is a bit lazy, best check exactly what
you've got, not least you've acutally got anything else it'll error.

Regards,
Peter T



[email protected]

Writing array to a range
 
Peter
Thanks. I think I'm missing something as it runs but nothing is deposited in the range. My VBA skills aren't great and my understanding of arrays even worse.

This is what I ended up with ...


Sub DelimitedTextFileToArray()

Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As Variant 'String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As Variant
Dim TempArray() As String
Dim rw As Long, col As Long
Dim filt_array As Variant
Dim dep_array As Variant



Application.StatusBar = False

FilePath = Application.GetOpenFilename(FileFilter:="Text File (*.txt),*.txt")
If FilePath = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If

'Inputs
Delimiter = ","

rw = 0

'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile

'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)

'Close Text File
Close TextFile

'Separate Out lines of data
LineArray() = Split(FileContent, vbCrLf)

'Read Data into an Array Variable
For x = LBound(LineArray) To UBound(LineArray)
If Len(Trim(LineArray(x))) = 0 Then
'do nothing

ElseIf InStr(1, LineArray(x), "FF") Then


'Split up line of text by delimiter
TempArray = Split(LineArray(x), Delimiter)

'Determine how many columns are needed
col = UBound(TempArray)
If col maxcol Then
maxcol = col


'Re-Adjust Array boundaries
ReDim Preserve DataArray(UBound(LineArray), col)
End If

'Load line of data into Array variable
For y = LBound(TempArray) To UBound(TempArray)
DataArray(x, y) = TempArray(y)
'Debug.Print DataArray(1, rw)
Next y
'End If
End If

'Next line
rw = rw + 1



Next x


Dim Destination As Range
Set Destination = Range("a1")

Destination.Resize(rw, maxcol + 1).Value = DataArray




End Sub

GS[_6_]

Writing array to a range
 
Perhaps...

Sub ImportTextFile()
Dim vData, sFile$, n&

sFile = Get_FileToOpen("Text File (*.txt),*.txt")
If sFile = "" Then Exit Sub '//user cancels

vData = Split(ReadTextFileContents(sFile), vbLf)
ReDim vTmp(UBound(vData))
For n = LBound(vData) To UBound(vData)
vTmp(n) = vData(n)
Next 'n
Call Xform_1DimArrayTo2D(vTmp, ",")
Cells(1).Resize(UBound(vTmp), UBound(vTmp, 2)) = vTmp
End Sub

Function Get_FileToOpen$(Optional FileTypes$ = "All Files ""*.*"",
(*.*)")
Dim vFile
vFile = Application.GetOpenFilename(FileTypes)
Get_FileToOpen = IIf(vFile = False, "", vFile)
End Function

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

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

Sub Xform_1DimArrayTo2D(Arr(), Delimiter$)
' Restructures a 1D dynamic 0-based array to a fixed 2D 1-based array
' Arguments:
' Arr$() array of delimited strings to be converted
' Delimiter$ arg for Split() function
'
Dim v1, vTmp(), lMaxCols&, lMaxRows&, n&, K&

If (VarType(Arr) < vbArray) Or (Delimiter = "") Then Exit Sub

lMaxRows = UBound(Arr) + 1: vTmp = Arr: Erase Arr
'Get size of Dim2
For n = LBound(vTmp) To UBound(vTmp)
K = UBound(Split(vTmp(n), Delimiter))
lMaxCols = IIf(K + 1 lMaxCols, K + 1, lMaxCols)
Next 'n

ReDim Arr(1 To lMaxRows, 1 To lMaxCols)
For n = LBound(vTmp) To UBound(vTmp)
v1 = Split(vTmp(n), Delimiter)
For K = LBound(v1) To UBound(v1)
Arr(n + 1, K + 1) = v1(K)
Next 'k
Next 'n
End Sub 'Xform_1DimArrayTo2D

--
Garry

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

GS[_6_]

Writing array to a range
 
Revise to suit...

vData = Split(ReadTextFileContents(sFile), vbLf)


...if vbCrLf is used.

--
Garry

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

[email protected]

Writing array to a range
 
Thanks that works for loading the file but the second question is to only load the data into the worksheet from the rows in which a specific value is found.

How could that be accomplished?

[email protected]

Writing array to a range
 
okay I put

if intr(1,vtmp(n),"FF") then (as below)

and it only captures the rows that have the FF in them but when these rows are placed within the worksheet location is the relative position within the original array. How do I close up the blank rows above and below within the array before placing into the worksheet range?



ReDim Arr(1 To lMaxRows, 1 To lMaxCols)
For n = LBound(vTmp) To UBound(vTmp)
If InStr(1, vTmp(n), "FF") Then
v1 = Split(vTmp(n), Delimiter)
For K = LBound(v1) To UBound(v1)
Arr(n + 1, K + 1) = v1(K)
Next 'k
End If
Next 'n

GS[_6_]

Writing array to a range
 
okay I put

if intr(1,vtmp(n),"FF") then (as below)

and it only captures the rows that have the FF in them but when these
rows are placed within the worksheet location is the relative
position within the original array. How do I close up the blank rows
above and below within the array before placing into the worksheet
range?


You need to extract the wanted data from vData into a 2nd array
(vData2) using ReDim Preserve, incrementing the UBound +1 each time the
row is found. Then Xform that array. The result should be the same
minus the unwanted data.

--
Garry

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

[email protected]

Writing array to a range
 
Thanks that help me to figure it out.


All times are GMT +1. The time now is 08:24 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com