I have this code in vba, trying to fill an dynamic array with data extracted from a text file but appears me an error
"subscripts out of range".
I did try to make this with non-zero based arrays but I receive the same error.
Module VBA
option explicit
Sub FromFileToExcel()
Dim Delimiter As String
Dim TextFile As Integer
Dim validRow As Integer
validRow = 0
Dim x As Integer
Dim i As Integer
Dim FilePath As String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As String
FilePath = "C:\Users\Jlopez25\Desktop\bertha\INVPLANT.prn"
TextFile = FreeFile
Open FilePath For Input As TextFile
FileContent = Input(LOF(TextFile), TextFile)
Close TextFile
LineArray() = Split(FileContent, vbCrLf)
For x = LBound(LineArray) To UBound(LineArray)
If validateData(LineArray(x)) Then
ReDim Preserve DataArray(validRow, 3) 'here occours the mistake
DataArray(validRow, 1) = Left(LineArray(i), 8)
DataArray(validRow, 2) = Mid(LineArray(i), 9, 7)
DataArray(validRow, 3) = Mid(LineArray(i), 18, 2)
validRow = validRow + 1
End If
Next x
Range("a1").Resize(UBound(DataArray, 1), UBound(DataArray, 2)).Value = DataArray()
End Sub
UDF
Public Function validateData(Data As String) As Boolean
If InStr(1, Left(Data, 8), ":", vbTextCompare) = 0 And _
Len(Replace(Left(Data, 8), " ", "", , , vbTextCompare)) > 7 And _
Left(Data, 1) <> "_" Then
validateData = True
Else
validateData = False
End If
End Function
this are some lines of the text file that I want to separate into DataArray() :
abc:c
page: 1
____________________________
site Location item
MX823JXIA1B38C08 01
MX823JXIA9B06C58 02
MX823JXIA9B12C76 03
ReDim Preserve DataArray(validRow, 3) 'here occours the mistake
that is because you cannot Redim Preserve
an Array by changing its first dimension, but only the last dimension. You might want to write your own custom function to achieve this special Redim
.
But from your code, I can see that it was possible to calculate the size of the array in a first loop, then do the work in another loop. although it is slow (depends on the complexity of the validateData
function), but it easy to achieve. Consider this:
Dim arSize as Integer
For x = LBound(LineArray) To UBound(LineArray)
If validateData(LineArray(x)) Then arsize = arSize + 1
Next
ReDim DataArray(arSize, 1 to 3) 'dimension the array
'And now do the calculation loop
For x = LBound(LineArray) To UBound(LineArray)
If validateData(LineArray(x)) Then
DataArray(validRow, 1) = Left(LineArray(i), 8)
DataArray(validRow, 2) = Mid(LineArray(i), 9, 7)
DataArray(validRow, 3) = Mid(LineArray(i), 18, 2)
validRow = validRow + 1
End If