I'm adapting a function that open a tabulatted .txt file and parse into a 2d Array.
It's been working fine with most my tabulatted .txt but this particular file I'm getting Error runtime 9 , is that because of the time of my file or a particular format on it's carriage return or tab etc? How can I debug this?
Any help is appreciated
Example of file that works
Example of File that error runtime 9
My code:
'Option Explicit
Sub test()
'On Error Resume Next 'just in case... comment this in dev. mode to see debug message
Dim myArr() As Variant
Dim m As Integer
Dim Path As String, Delim As String
Dim ArchiFile As String
Delim = vbTab 'if Tabullated .txt 'vbTab Chr( 9 ) Tab character
'Delim = "," 'if Coma Separated Value .csv
ArchiFile = "C:\Users\diego\Desktop\RoofDataBase.txt"
'Error runtime 9
'Download file here https://www.dropbox.com/s/zg8otjfhtb5vxb2/RoofDataBase.txt?dl=0
Path = "C:\Users\diego\Desktop\A340.txt"
'Works!
'Download file here https://www.dropbox.com/s/6vosudkytx6vjjl/A340.txt?dl=0
'****** WHERE THE MAGIC HAPPEN *****
'myArr = TwoDArr(ArchiFile, Delim) 'not working with roof export? it does open and loop trough in function but not save in array
myArr = TwoDArr(Path, Delim) 'works for schema exports (perhaps suze?
'********* END OF MAGIC ************
Debug.Print "sub - "; myArr(2, 2) 'Remember arrays start at 0, so (1,1) means "B2", (1,0) means "A2")
End Sub
Function TwoDArr(file As String, Delim As String) As Variant
'This function open up a .csv or tabulatted .txt and parse it's info to an array
'It loop row by row (RowData) and in each Row, loops Column by Column (ColData) saving it's values
'in TempTwoDArr() which is then parsed to function request (TwoDArr)
'Adapted from https://stackoverflow.com/questions/12259595/load-csv-file-into-a-vba-array-rather-than-excel-sheet
Dim MyData As String, RowData() As String, ColData() As String
Dim TempTwoDArr() As Variant
Dim i As Long, n As Long
Open file For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
RowData() = Split(MyData, vbLf) 'for some reason RoodDatabase.txt only contain Linefeed character (No Carriage Return) and this will work on splitting other files too.
'RowData() = Split(MyData, vbCrLf) 'vbCrLf Chr( 13 ) + Chr( 10 ) Carriage return-linefeed combination
'source https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/miscellaneous-constants
Rs = UBound(RowData)
ReDim Preserve TempTwoDArr(Rs, 0)
For i = LBound(RowData) To UBound(RowData)
If Len(Trim(RowData(i))) <> 0 Then
ColData = Split(RowData(i), Delim)
'n = n + 1
ReDim Preserve TempTwoDArr(Rs, UBound(ColData))
For n = LBound(ColData) To UBound(ColData)
TempTwoDArr(i, n) = ColData(n)
Debug.Print ColData(n)
Next n
End If
Next i
TwoDArr = TempTwoDArr()
Debug.Print TempTwoDArr(2, 2)
Erase TempTwoDArr 'clear up memory
End Function
[Edit 1] Amended Variable file should read Path on line 17
[Solution] Amended RowData() = Split(MyData, vbLf) instead of RowData() = Split(MyData, vbCrLf) 'for some reason RoodDatabase.txt only contain Linefeed character (No Carriage Return) and since this file is generated in a 3rd party software I have no control over it.
vBLf will work on splitting other files rows too.
Related
I have this text file that is tab separated with about 1,000 columns and 12,000 rows when pasted into an excel spreadsheet. My goal is to have some way where I can compare an array of strings
arWords = Array("Title1", "Title2", "Title3")
To the column headers in that .txt file. When a match is found i would like to know what "column" that word was found in, and put it in another array. In this example it would be an array of 3 integers each one representing which column each Title was found. My goal is to end up with an array that looks like this.
listIndex = array(159, 393, 400)
And if i include 4 Titles in arWords, then i will end up with an array of 4 integers representing their column #.
Here is my code, its not good im very bad at this, but thanks nonetheless!
Const ForReading = 1
Dim FSO, FileIn, strTmp
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileIn = FSO.OpenTextFile(movietitles.txt, ForReading)
arWords = Array("Title1", "Title2", "Title3")
size = UBound(arWords) - LBound(arWords) + 1
Dim listIndex() As Integer
ReDim listIndex(size)
Do Until FileIn.AtEndOfStream
strTmp = FileIn.ReadLine
If Len(strTmp) > 0 Then
For i = 0 To UBound(arWords)
If InStr(1, strTmp, arWords(i), vbTextCompare) > 0 Then
listIndex(i) = i
Exit For
End If
Next
End If
Loop
FileIn.Close
ReDim yArray(1 To lColumn)
Dim Counter As Integer
For Counter = 1 To lColumn
yArray(Counter) = 9
Next Counter
For Each Index In listIndex
yArray(Index) = 1
Next Index
If my assumption after reading your comment is correct, please try the next code. I assumed that the header is on the first row of the text file. No need to open it in Excel:
Sub MatchStringArrayToHeaders()
Dim fileName As String, arWords, arrTxt, arrH, arrFin, El, mtch
Dim k As Long, headRow As Long i As Long
fileName = ThisWorkbook.path & "\MyTestFile.txt" 'use here your text file full name
arWords = Array("Title1", "Title2", "Title3")
ReDim arrFin(UBound(arWords)) 'redim the final array to be returned
'put all the text file content in an array of rows:
arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fileName, 1).ReadAll, vbCrLf)
'find the header row: __________________________
For i = 0 To UBound(arrTxt)
arrH = Split(arrTxt(i), vbTab)
If UBound(arrH) > 0 Then
If arrH(1) <> "" Then HeaderRow = i: Exit For
End If
Next i
'_______________________________________________
arrH = Split(arrTxt(headRow), vbTab)
For Each El In arWords
mtch = Application.match(El, arrH, 0) 'return the matching header number
If IsNumeric(mtch) Then 'if a match could be found
arrFin(k) = mtch: k = k + 1 'put the column number in the final array
Else
'if not any match, write in Immediate Window the not matching string
Debug.Print El & " could not be found in the headers row..."
End If
Next
'Only to visually check the returned array:
Debug.Print Join(arrFin, "|") 'the obtained array is joined using "|" separator and returned in Immediate Window (`Ctrl + G`, being in VBE).
End Sub
If the headers row is not all the time the same, please give me the column 1 marker for this header row and I will adapt the code to firstly search for this marker, set the headers row and use it...
Scenario: I have a workbook with multiple worksheets. I am trying to use a function (called within a sub) to export arrays with data from certain worksheets. The arrays are created before the function with the content from the worksheet with:
If ws.Name = "AA" Then
expaa = ws.UsedRange.Value
End if
where expaa is previously defined as variant.
The function I am using apparently finishes running, but the output on the new file saved is weird: instead of having one row of headers, the first row is split into 2 for some reason (all the others remain the same).
This is the function I am using:
Function Exporter(arr As Variant, y As String, OutPath As String) As Variant
Dim lrow As Long, lColumn As Long
Dim w2 As Workbook
Dim d As Date
Workbooks.Add
Set w2 = ActiveWorkbook
w2.Worksheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
Application.DisplayAlerts = False
w2.SaveAs Filename:=OutPath & "\" & y, FileFormat:=6
Application.DisplayAlerts = True
w2.Close True
End Function
Which I call from the main sub with:
If aa_name <> "" Then
Exporter expaa , "aa_OK", wbpath
End If
where aa_name is the name of the file used to retrieve the path.
Obs: The wbpath variable is a string with the path of my main workbook (therefore the new file is saved at the same location).
Question: What may be causing the first row of my output to be split? How can that be fixed?
Obs2: I know this can be done with copy procedure, and looping through the array and so on. I even got it to work with other methods. This post is only to understand what I am doing wrong with the current code.
Obs3: Regarding the data that is going to be passed: it is a matrix of days, identifiers and data, ex:
Item1 Item2 Item3
01/01/2000 1 1 2
02/01/2000 1 2 1
03/01/2000 2 2 2
with around 2000 rows and 3000 columns.
UPDATE: After retesting the code multiple times, It appears that the data of the first row only gets split when the file is save as csv (when the array is pasted, the output is normal). Any idea on what may be the cause for that?
I know this is old but here is my solution for the googlers. This accepts an array and creates a CSV at a path you define. Its probably not perfect but it has worked so far for me.
Option Explicit
Option Private Module
Public Function SaveTextToFile(ByVal targetarray As Variant, ByVal filepath As String) As Boolean
On Error GoTo CouldNotMakeFile
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fileStream As TextStream
' Here the actual file is created and opened for write access
Set fileStream = fso.CreateTextFile(filepath)
' Write something to the file
Dim Row As Long, Col As Long
For Row = LBound(targetarray, 1) To UBound(targetarray, 1)
For Col = LBound(targetarray, 2) To UBound(targetarray, 2)
fileStream.Write StringCompliance(targetarray(Row, Col)) & IIf(Col = UBound(targetarray, 2), "", ",")
Next Col
fileStream.WriteBlankLines 1
Next Row
' Close it, so it is not locked anymore
fileStream.Close
' Here is another great method of the FileSystemObject that checks if a file exists
If fso.FileExists(filepath) Then
SaveTextToFile = True
End If
CouldNotMakeFile:
End Function
Private Function StringCompliance(ByVal InputString As String) As String
Dim CurrentString As String
CurrentString = InputString
'Test if string has qoutes
If InStr(CurrentString, Chr$(34)) > 0 Then
CurrentString = Chr$(34) & Replace(CurrentString, Chr$(34), Chr$(34) & Chr$(34)) & Chr$(34)
StringCompliance = True
Else
'Tets if string has commas or line breaks
If InStr(CurrentString, ",") > 0 Or InStr(CurrentString, vbLf) > 0 Then
CurrentString = Chr$(34) & CurrentString & Chr$(34)
Else
StringCompliance = False
End If
End If
StringCompliance = CurrentString
End Function
please bear with me as I'm very new to VBA, with prior experience primarily from Rhinoscript and other dedicated scripting options. The question is really very simple and I reckon someone can answer this very quickly, as I'm poor with arrays in VBA:
I have a spreadsheet where the objective is to import a number of values and text strings (resulting in some blanks) into e.g. A:L. This is done manually. I need to read these values into an array and then print them into a file so that each file row corresponds to a row of columns in the array. Currently I cannot seem to be able to convert the variant array into a string array (apparently necessary) and then join the subarrays into temporary arrays which are printed into the file. The following bit I've managed to scrape together results in a file output where each array value is on a single row, where as I'd like the contents of e.g. A1:L1 to be printed on single row.
Sub writerangetofile()
'Write data to a text file
'Declaring variables
Dim valarray() As Variant
Dim R As Long
Dim C As Long
'Set array as range
Sheet1.Activate
valarray() = Range("A1:L40")
'Setting the name and the path of text file based on workbook path
sFName = ThisWorkbook.Path & "\Output.txt"
'Get an unused file number
intFNumber = FreeFile
'Create a new file (or overwrite an existing one)
Open sFName For Output As #intFNumber
For R = 1 To UBound(valarray, 1) ' First array dimension is rows.
For C = 1 To UBound(valarray, 2) ' Second array dimension is columns.
Print #intFNumber, valarray(R, C)
Next C
Next R
'Close the text file
Close #intFNumber
End Sub
For simplicity as I've also not figured out how to obtain the last row with any content in it I've restricted the range to row 40 for now.
Any ideas on how to accomplish what I want elegantly? I've solved it by assigning single cells to variables, but I'd prefer to do it with an array. Ultimately I will later be interjecting a fixed text string after a recurring text string in the imported text, which is then followed by a numerical value obtained from a calculation.
Many thanks for any help and apologies for the ignorance.
In case you have any issues, this versions shows how to determine the last row and column
Option Explicit
Public Sub RangeToFile()
Dim ws As Worksheet, lr As Long, lc As Long, r As Long, c As Long
Dim arr As Variant, fName As String, fNumber As Long, txtLine As String
fName = ThisWorkbook.Path & "\Output.txt" 'File name & path based on workbook path
Set ws = Sheet1 'set a reference to main sheet
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last row in column A
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'find last column in row 1
arr = ws.Range(ws.Cells(1, "A"), ws.Cells(lr, lc)) 'Copy range to array
fNumber = FreeFile 'get next available file number assigned by windows
Open fName For Output As #fNumber 'create a new file, or overwrite an existing one
For r = 1 To UBound(arr, 1) '1st array dimension is rows
For c = 1 To UBound(arr, 2) '2nd array dimension is columns
txtLine = txtLine & arr(r, c) & ", " 'concatenate each cell in row, on a line
Next c 'the end of the row, moving to next one
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove the extra comma at end of line
txtLine = txtLine & vbCrLf 'append a carriage return to the line
Next r
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove carriage return at end of line
Print #fNumber, txtLine 'print entire text to the file with an extra carriage return
Close #fNumber 'close the text file
End Sub
and this one transposes columns to rows:
Public Sub RangeToFileColumnsToRows()
Dim ws As Worksheet, lr As Long, lc As Long, r As Long, c As Long
Dim arr As Variant, fName As String, fNumber As Long, txtLine As String
fName = ThisWorkbook.Path & "\Output.txt" 'File name & path based on workbook path
Set ws = Sheet1 'set a reference to main sheet
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last row in column A
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'find last column in row 1
arr = ws.Range(ws.Cells(1, "A"), ws.Cells(lr, lc)) 'Copy range to array
fNumber = FreeFile 'get next available file number assigned by windows
Open fName For Output As #fNumber 'create a new file, or overwrite an existing one
For c = 1 To UBound(arr, 2) '2nd array dimension is columns
For r = 1 To UBound(arr, 1) '1st array dimension is rows
txtLine = txtLine & arr(r, c) & ", " 'concatenate each cell in col, on a line
Next r 'the end of the col, moving to next one
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove the extra comma at end of line
txtLine = txtLine & vbCrLf 'append a carriage return to the line
Next c
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove carriage return at end of line
Print #fNumber, txtLine 'print entire text to the file
Close #fNumber 'close the text file
End Sub
Nevermind, I think I got a step forward:
For R = 1 To UBound(valarray, 1) ' First array dimension is rows.
For C = 1 To UBound(valarray, 2) ' Second array dimension is columns.
ReDim Preserve tvalarray(1 To C) 'Reset the array dimension on each iteration of loop whilst keeping results
'Input each single value into subarray for joining
tvalarray(C) = valarray(R, C)
'Join the subarray
jstring = Join(tvalarray)
Next C
ReDim Preserve jvalarray(1 To R) 'Reset the array dimension on each iteration of loop whilst keeping results
'Input the joined result into the new array
jvalarray(R) = jstring
'Print to file
Print #intFNumber, jvalarray(R)
Next R
This seems to do the job, I'll see if I run into pitfalls later.
I'm trying to automate the import of data into a tool I'm building in Excel. The idea is to read the data from a .csv file either directly into an array, or read the data as a string and then parse it using spaces " " and commas "," as delimiters, followed by an array. I've gotten this far:
Public Sub ImportData()
Dim myData as String, strData() as String
Dim thisFile as String
thisFile = ActiveWorkbook.Path & "\" & "s.csv"
Open thisFile For Binary As #1
myData = Space$(LOF(1))
Get #1, , myData
Close #1
End Sub
This gets me to where "myData" is a now string of data separated by commas and spaces (commas delimiting for a new column, spaces delimiting for a new row).
How do I proceed to reconstruct this as a multidimensional (2D) array so that it can be printed onto the sheet I'm working on, or referenced straight from memory? Or is there an easier way?
This is the implementation suggested by #Tim
Option Explicit
Public Sub OpenFile()
Dim rawData As String, lineArr As Variant, cellArr As Variant
Dim ubR As Long, ubC As Long, r As Long, c As Long
Open ActiveWorkbook.Path & "\" & "s.csv" For Binary As #1
rawData = Space$(LOF(1))
Get #1, , rawData
Close #1
If Len(rawData) > 0 Then
'If spaces are delimiters for lines change vbCrLf to " "
lineArr = Split(Trim$(rawData), vbCrLf)
ubR = UBound(lineArr) + 1
ubC = UBound(Split(lineArr(0), ",")) + 1
ReDim arr(1 To ubR, 1 To ubC)
For r = 1 To ubR
If Len(lineArr(r - 1)) > 0 Then
cellArr = Split(lineArr(r - 1), ",")
For c = 1 To ubC
arr(r, c) = cellArr(c - 1)
Next
End If
Next
ActiveSheet.Range(Cells(1), Cells(ubR, ubC)) = arr 'Place array on the sheet
End If
End Sub
I have a directory with .txt files in it. I am writing each file's line to an array and need to know if any lines in a file match any lines in another file.
Example:
If any item in Array1 = any item in Array2 then...
Code thus far:
For Each foundBaseFile As String In My.Computer.FileSystem.GetFiles _
(DataDir, _
FileIO.SearchOption.SearchTopLevelOnly, "*.vpk.txt")
Dim BaseTextArray = IO.File.ReadAllLines(foundBaseFile)
For Each foundCheckFile As String In My.Computer.FileSystem.GetFiles _
(DataDir, _
FileIO.SearchOption.SearchTopLevelOnly, "*.vpk.txt")
If Not foundBaseFile = foundCheckFile Then
Dim CheckTextArray = IO.File.ReadAllLines(foundCheckFile)
'If any item in CheckTextArray = any item in BaseTextArray then
' Do X
'End If
End If
Next
Next
Thanks!
This should do the trick.
If BaseTextArray.Any(Function(o) CheckTextArray.Contains(o)) Then
' Do X
Declare two array variable
dim arr1() as string
dim arr2() as string
Read values from .txt file line b line and add to each arrarlevel. You can also split lines by vbnewline
then use
Array.Indexof()
method to find whether values in first array string exist in other.
If indx >1 then
True
Else
False
end if