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
Related
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.
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 have problem with my matching function actually I have to count number of lines with specific string and return line number ,so I have one dimensional array of string that contain the unique strings of text file {33,7,77,3 23,6} and text file with the same strings in array I have read lines of text file to array , but with duplicate of these strings ,when I use regex.match it works not bad expect when I check if line 2 contain 3 the function return True it's consider 3 in 23 as 3 , and the above explanation is just example of what I need any help please
Module Module1
Sub Main()
Dim txt As String = File.ReadAllText("e:\ii.txt")
' Use regular expressions to replace characters
' that are not letters or numbers with spaces.
Dim reg_exp As New Regex("[^a-zA-Z0-9]")
txt = reg_exp.Replace(txt, " ")
' Split the text into words.
'Dim words() As String = txt.Split( _
' New Char() {" "c}, _
' StringSplitOptions.RemoveEmptyEntries)
Dim words = txt.Split(New String() {" ", Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
' Use LINQ to get the unique words.
Dim word_query = _
(From word As String In words _
Order By word _
Select word).Distinct()
Dim stra() As String = word_query.ToArray()
For i = 0 To stra.Length - 1
Console.WriteLine(" " & stra(i))
Next
Dim lines() As String = IO.File.ReadAllLines("e:\ii.txt")
For i = 0 To lines.Length - 1
Console.WriteLine(lines(1))
Dim linecount = 0
Dim regex As New Regex(stra(i), RegexOptions.ExplicitCapture)
Dim match As Match = regex.Match(lines(1))
If match.Success Then
linecount += 1
Console.WriteLine("linecount= " & linecount)
Else
Console.WriteLine("false")
End If
Next
End Sub
End Module
You many not have to split the text into words. Is your word list very long? From what I understand you want the following:
1.Read a text file and return the line number for a given word or phrase.
Is the word or phrase complex? If not, why not use a the Contains extension method?
For example:
Dim myString = "Hello World"
If myString.Contains("World") Then
'Add line number to line count.
End if
If you are using this as an opportunity to learn regular expressions, I highly recommend "Mastering Regular Expressions" by Jeffrey Friedl. When I first begun I invested in a program RegexBuddy, which is worth the money. But now there are so many online regex testers now, that could be an alternative for something free.
Enhance your regex with anchors. These will ascertain that the whole test string matches instead of a substring. The following code also assembles all match patterns of interest into a single regex pattern which will be used against each line of the target file:
Dim strall As String
strall = ""
For i = 0 To stra.Length - 1
If i > o Then
strall = strall & "|"
End If
strall = strall & stra(i)
Console.WriteLine(" " & stra(i))
Next
strall = "^(" & strall & ")$"
Dim regexall As New Regex(strall, RegexOptions.ExplicitCapture)
'...
Dim linecount = 0
Dim match As Match = regexall.Match(lines(i)) '... was 'lines(1)', probably a typo
If match.Success Then
'...
this code is working with me thanks for all
Public Function countlines(ByVal st As String) As Integer
Dim count As Integer
Dim linecount As Integer = 0
Dim substrings() As String = Regex.Split(st, " ")
Dim stt() As String = {23, 7, 3}
For i = 0 To stt.Length - 1
'For j = 0 To substrings.Length - 1
'Console.WriteLine(substrings(0))
'For i = 0 To substrings.Length - 1
'Console.Write(substrings(i))
Dim matchQuery = From word In substrings Where word.ToLowerInvariant() = stt(i).ToLowerInvariant() Select word
' ' Count the matches.
count = matchQuery.Count()
Console.WriteLine("count=" & count)
If count > 0 Then
linecount += 1
Else
Console.WriteLine(" linecount=" & linecount)
End If
Next
Console.WriteLine("linecount= " & linecount)
Return linecount
End Function
Sub Main()
Dim lines() As String = IO.File.ReadAllLines("e:\ii.txt")
For Each line As String In lines
countlines(line)
Next
End Sub
I am trying to display information from a text file into a multiline textbox. I run the code but the system displays an error message 'Index was outside the bounds of the array'. There are no obvious error messages and I can't seem to manipulate the code to get rid of this problem. Take a look:
Public Class TeachCon
Dim layout As String
Dim Contacts(6) As Details
Structure Details
Dim Name As String
Dim Email As String
Dim RoomNum As String
Dim number1, number2 As Integer
End Structure
Sub LoadTeachContacts(ByRef Contacts() As Details)
Dim TextFile As String = "\\Sjcdom01\mstudent\LHeywood\documents\A2\Computing\Comp 4 - Smail\Project\Text Files\Teacher Contact List.txt"
Dim TextLine As String = ""
Dim ArrayCounter As Integer = 0
Dim objReader As New System.IO.StreamReader(TextFile)
'loop through text file and load all contacts
Do While objReader.Peek() <> -1
'read next line from file
TextLine = TextLine & objReader.ReadLine() & vbNewLine
'declare an array and use it to split line from file
Dim TempArray() As String = Split(TextLine, ",")
'transfer each array element into the appropriate part of the contacts stucture
Contacts(ArrayCounter).Name = TempArray(0)
*Contacts(ArrayCounter).Email = TempArray(1)*
Contacts(ArrayCounter).RoomNum = TempArray(2)
Contacts(ArrayCounter).number1 = TempArray(3)
Contacts(ArrayCounter).number2 = TempArray(4)
'empty string before reading next line from file
TextLine = ""
'increment array counter
ArrayCounter = ArrayCounter + 1
Loop
End Sub
Private Sub ButShow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim ArrayCounter As Integer = 0
LoadTeachContacts(Contacts)
Do Until ArrayCounter = 3
layout = Contacts(ArrayCounter).Name & "," & Contacts(ArrayCounter).Email & "," & Contacts(ArrayCounter).RoomNum & "," & Contacts(ArrayCounter).number1 & "," & Contacts(ArrayCounter).number2
If ArrayCounter = 0 Then
TextBox7.Text = layout
End If
ArrayCounter += 1
Loop
End Sub
End Class
The text enclosed by the * is where the system says it is outside the bounds of the array.
Well, one of your lines probably splits into an array that is shorter than you expect, and hence the index does not exist. Check the length of the array before you get the value. Maybe something like this
If TempArray.Length > 0 Then Contacts(ArrayCounter).Name = TempArray(0)
If TempArray.Length > 1 Then Contacts(ArrayCounter).Email = TempArray(1)
If TempArray.Length > 2 Then Contacts(ArrayCounter).RoomNum = TempArray(2)
If TempArray.Length > 3 Then Contacts(ArrayCounter).number1 = TempArray(3)
If TempArray.Length > 4 Then Contacts(ArrayCounter).number2 = TempArray(4)
Don't know exactly what your TextFile contains in it. But inorder to handle the exception change the code as below
'declare an array and use it to split line from file
Dim TempArray() As String = Split(TextLine, ",")
'transfer each array element into the appropriate part of the contacts stucture
If TempArray.Length > 0 Then
Contacts(ArrayCounter).Name = TempArray(0)
*Contacts(ArrayCounter).Email = TempArray(1)*
Contacts(ArrayCounter).RoomNum = TempArray(2)
Contacts(ArrayCounter).number1 = TempArray(3)
Contacts(ArrayCounter).number2 = TempArray(4)
End If
'empty string before reading next line from file
TextLine = ""
It would be helpful if you could give the content of the file also:
"\Sjcdom01\mstudent\LHeywood\documents\A2\Computing\Comp 4 - Smail\Project\Text Files\Teacher Contact List.txt"
I think that you should check if the line is empty or not, because the item 0 will be available without error as a Null String, but the item 1 will throw 'Index was outside the bounds of the array' In LoadTeachContacts Sub
'read next line from file
If objReader.ReadLine().Trim = "" Then Continue Do
TextLine = TextLine & objReader.ReadLine() & vbNewLine
Apologies for badly worded question.
I have the below table in excel:
The real file is 800 colums wide and 2800 rows deep so over 2 million combinations. more over its really difficult to manage in a database.
I need to convert the data to a database friendly format, something like:
Being honest I have no idea where to start. is there a reverse pivot in excel or an existing script to do this?
so logic, where row meets column in excel, fetch value and write all three to a database format.
any pointers?
Thanks as always
You could use this code to create a csv file that you can then import into the database of your choice. I tested it on a dataset of similar size to the one you described and it completed in about 30 seconds.
Sub tgr()
Dim arrData As Variant
Dim rIndex As Long
Dim cIndex As Long
Dim i As Long
Dim strLine As String
Dim strTemp As String
arrData = Range("A1", Cells(Cells(Rows.Count, "A").End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column)).Value
Close #1
Open "C:\Temp\ExcelData.csv" For Output As #1
Print #1, "Product,Customer,Price"
For rIndex = 2 To UBound(arrData, 1)
For cIndex = 2 To UBound(arrData, 2)
strLine = vbNullString
For i = 1 To 3
strTemp = Choose(i, arrData(rIndex, 1), arrData(1, cIndex), arrData(rIndex, cIndex))
If InStr(1, strTemp, ",", vbTextCompare) > 0 Then strTemp = """" & strTemp & """"
strLine = strLine & "," & strTemp
Next i
Print #1, Mid(strLine, 2)
Next cIndex
Next rIndex
Close #1
Erase arrData
End Sub
You can use the transpose function for this purpose.