I am working on an excel spreadsheet that takes data from a CSV file (produced automatically by an external system).
I have used:
Data->Get External Data->From Text
And it works perfect !
However i am not able to format the imported data as a table :-(
It gives the following message :
Your Selection overlaps one or more external data ranges. Do you want to convert the selection to a table and remove all external connections?
Is there a way to format the imported data as a table wthout breaking the connection ?
Thanks
Martin
This should work for you - make sure you have a tab called Data and you change the public const to the path of the file. I assume you know what to do with this code, if not let me know.
Public Const feedDir = "C:\Program Files\Common Files\System\data.csv" 'change this to the path of the file
Sub loadDataWrapper()
'''check file is in directory before proceding
If Dir(feedDir) <> "" Then
fileToLoad = feedDir
Else
MsgBox "No file available to load. Please check the path and try again."
Exit Sub
End If
Call loadData(fileToLoad)
End Sub
Sub loadData(ByVal fileToLoad As String)
Dim fso As Object, textFile As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim textFileStr As String
Dim textFileArr As Variant
Dim outputArr() As Variant
Dim oneRow As Variant
Dim numRows, numColumns As Long
'''open the text file and read into memory as is
Set textFile = fso.OpenTextFile(fileToLoad, 1)
textFileStr = textFile.ReadAll
textFile.Close
Set textFile = Nothing
Set fso = Nothing
'''find number of rows and columns of text file
textFileArr = Split(textFileStr, Chr(10))
numRows = UBound(textFileArr)
numColumns = UBound(Split(textFileArr(0), ","))
ReDim outputArr(numRows, numColumns)
'''go through every line and insert into array
For ii = 0 To (numRows - 1)
oneRow = Split(textFileArr(ii), ",")
For jj = 0 To numColumns
outputArr(ii, jj) = oneRow(jj)
Next jj
Next ii
'''output array to Worksheet
Worksheets("Data").Range("A2:Z1048576").ClearContents
Worksheets("Data").Range("A2").Resize(numRows + 1, numColumns + 1).Value = outputArr
End Sub
Would a Pivot Table satisfy your requirement?
Insert>PivotTable>Use External Data Source Radio Button
Related
I'm trying to write a VBA macro that will read through a text document and place specific words into columns. UPDATE: Here's a sample of the file, apparently it's XML, so at least I learned something new today. So i guess what I need is a program to shed the XML parts, and place just the text into columns.
<Alarm>
<ID>1002</ID>
<Type>Fault</Type>
<Message>Bad Brake</Message>
<Tagname>error.e2</Tagname>
</Alarm>
<Alarm>
<ID>1004</ID>
<Type>Fault</Type>
<Message>No Motion</Message>
<Tagname>error.e4</Tagname>
</Alarm>
<Alarm>
<ID>1005</ID>
<Type>Fault</Type>
<Message>Upper safety door open</Message>
<Tagname>error.e5</Tagname>
</Alarm>
Ultimately, I'm trying to put the 4 digit error codes in column A (i.e. 1002, 1004...), and the error message in column B (i.e. Bad Brake, No motion....). I'll paste what I have so far, I tried coding it for just one pair of data to start. I'm stuck trying to get the error message into column B. The error messages all start in the same position on each line, but I can't figure out how to stop copying the text, since each error message is a different length of characters. Any ideas?
(P.S. - I apologize if the code is terrible, I've been interning as an electrical engineer, so my programming has gotten rather rusty.)
Private Sub CommandButton1_Click()
Dim myFile As String, textLine As String, ID As Integer, error_msg As Integer
myFile = "C:\Users\scholtmn\Documents\Projects\Borg_Warner_txt_file\BW_fault_codes.txt"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textLine
Text = Text & textLine
Loop
Close #1
ID = InStr(Text, "<ID>")
error_msg = InStr(Text, "<Message>")
Range("A1").Value = Mid(Text, ID + 4, 4)
Range("B1").Value = Mid(Text, error_msg + 9, (InStr(Text, " <") - 31))
End Sub
Please, try the next code:
Sub ExtractErrorsDefinition()
'it needs a reference to 'Microsoft XML, v6.0'
Dim XMLFileName As String, oXMLFile As New MSXML2.DOMDocument60, sh As Worksheet
Dim N As MSXML2.IXMLDOMNode, i As Long, arr
Set sh = ActiveSheet 'use here the necessary sheet
XMLFileName = "the full text file path" '"C:\Utile\Teste Corel\XMLtext.txt"
oXMLFile.Load (XMLFileName)
ReDim arr(1 To oXMLFile.SelectNodes("AlarmDictionary/Alarm").length, 1 To 2): i = 1
For Each N In oXMLFile.SelectNodes("AlarmDictionary/Alarm")
arr(i, 1) = N.SelectSingleNode("ID").Text: arr(i, 1) = N.SelectSingleNode("Message").Text: i = i + 1
Next
sh.Range("A2").Resize(UBound(arr), 2).value = arr
End Sub
It may work using late binding, but it is better to have the intellisense suggestion, especially when not very well skilled in working with XML.
If looks complicated to add such a reference, I can add a piece of code to automatically add it.
Please, run the next code to automatically add the necessary reference. Save your workbook and run the first code after:
Sub addXMLRef()
'Add a reference to 'Microsoft Scripting Runtime':
'In case of error ('Programmatic access to Visual Basic Project not trusted'):
'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
' check "Trust access to the VBA project object model"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\msxml6.dll"
End Sub
It looks like the txt file you are using is actually an xml file. If you changed the format, this piece of code I slightly adjusted from here should work fine.
Sub From_XML_To_XL()
Dim xmlWb As Workbook, xSWb As Workbook, xStrPath$, xfdial As FileDialog, _
xFile$, lr%, first As Boolean, r As Range
first = True
Set xfdial = Application.FileDialog(msoFileDialogFilePicker)
xfdial.AllowMultiSelect = False
xfdial.Title = "Select an XML File"
If xfdial.Show = -1 Then xStrPath = xfdial.SelectedItems(1) & ""
If xStrPath = "" Then Exit Sub
Set xSWb = ThisWorkbook
lr = xSWb.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row ' last used row, column A
xFile = xStrPath
Set xmlWb = Workbooks.OpenXML(xFile)
If first Then
Set r = xmlWb.Sheets(1).UsedRange ' with header
Else
xmlWb.Sheets(1).Activate
Set r = ActiveSheet.UsedRange
Set r = Range(Cells(3, 1), Cells(r.Rows.Count, r.Columns.Count))
End If
r.Copy xSWb.ActiveSheet.Cells(lr + 1, 1)
lr = xSWb.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row
xmlWb.Close False
first = False
End Sub
I think you'll find this task a lot easier if you take advantage of the fact it is in XML format. You can find more information about working with XML in VBA here.
As Ben Mega already stated: you have an XML-File - why not use XML-functionality.
Add "Microsoft XML, v6.0" to your project references - then you can use this code
Public Sub insertTextFromXML()
Dim objXML As MSXML2.DOMDocument60
Set objXML = New MSXML2.DOMDocument60
If Not objXML.Load("T:\Stackoverflow\Test.xml") Then
Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason
End If
Dim nAlarm As MSXML2.IXMLDOMNode
'loop through all alarms and output ID plus message
For Each nAlarm In objXML.SelectNodes("AlarmDictionary/Alarm")
With nAlarm
Debug.Print .SelectSingleNode("ID").Text, .SelectSingleNode("Message").Text
End With
Next
'Filter for ID 1004
Set nAlarm = objXML.SelectSingleNode("AlarmDictionary/Alarm[ID=1004]")
Debug.Print nAlarm.XML
End Sub
You can google for VBA XPath to find out how to access the various values.
Sub GetFileList()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim objOL As Object
Dim Msg As Object
Dim xPath As String
Dim thisFile As String
Dim i As Integer
Dim lastrow As Long
xPath = Sheets("UI").Range("D7")
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
i = 1
For Each xFile In xFolder.Files
i = i + 1
Worksheets("Info").Cells(i, 1) = xPath
Worksheets("Info").Cells(i, 2) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
Worksheets("Info").Cells(i, 3) = Mid(xFile.Name, InStrRev(xFile.Name, ".") + 1)
Worksheets("Info").Cells(i, 6) = Left(FileDateTime(xFile), InStrRev(FileDateTime(xFile), " ") - 1)
Next
Set Msg = Nothing
Worksheets("Info").Visible = True
Worksheets("Info").Activate
End Sub
The code to extract file information from a folder. The issue is when I change the folder path, it overwrites on the previously fetched data.
Sheet -UI is where the sub executed on press of button, Sheet Info is the place where the data needs to be pasted.
How to write the code to add a new row of data after the data which is already available. If the sheet is blank then add data from the 1st ROW otherwise add data from the LAST ROW.
Sheets("UI").Range("A1").End(xlDown).Select
i = Selection.Row + 1
Try replacing
i = 1
with
i = Worksheets("Info").UsedRange.Rows.Count + 1
This will set i to 1 the first time around, and to the first free row ever after. New data will be added below the existing data, if there is any.
I am very new to VBA and I'm looking to use it to automate some of my processes. I have looked around this website (and others) and although I find very similar queries, I can't seem to find one that fits my needs exactly.
So far the closest thing I've found to what I'm looking to do is this: Wanting to create a search field and button to trigger VBA script to run
I have a source folder with all my data. My data is stored in multiple text files. Here is an example of what the data in the files looks like:
10001,1,205955.00
10001,2,196954.00
10001,3,4.60
10001,4,92353.00
10001,5,85015.00
10001,6,255.90
10001,7,804.79
10001,8,205955.00
10001,9,32465.00
In each row, the first number is a geographic code, second number is a numeric code for a specific indicator (not important for what I'm trying to do), and the third number is the value I want to import into my spreadsheet. Each geographic code is associated with 2247 rows.
I want to use a search box control in Excel that I can type a specific geographic code into, click a button and then the macro would run, searching the files for that specific code and then importing all the values - in the order they are listed in the data file - into my desired range in the workbook.
So far I've gotten this code written. Again, forgive me if this is bad code... I tried to re-purpose the code from the other forum post I mentioned earlier.
I think I setup the import location right... I want it to import into column C, row 3 of the sheet that the search box/button combo will be present on. But now, I am unsure how I would get the import aspect to work. Thanks in advance for anyone who can help on this issue.
Sub SearchFolders()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim TS As Object
Dim SourceFolder As String
Dim Search As String
Dim LineNumber As Long
Dim DataSh As Worksheet
SourceFolder = "C:\Users\MarMar\Desktop\Data\Census2016\DataFiles\"
Search = TextBox1.Value
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(SourceFolder)
Set DataSh = ActiveSheet.Cells(3, 3)
For Each File In Folder.Files
Set TS = File.OpenAsTextStream()
LineNumber = 0
Do While Not TS.AtEndOfStream
LineNumber = LineNumber + 1
If InStr(TS.ReadLine, Search) Then
'Code to Import Values to DataSh ???
End If
Loop
TS.Close
Next File
End Sub
Maybe something like this:
Dim arr
For Each File In Folder.Files
Set TS = File.OpenAsTextStream()
LineNumber = 0
Do While Not TS.AtEndOfStream
arr = Split(TS.ReadLine, ",") 'split line to array
'check first element in array
If arr(0) = Search Then
datash.Resize(1, UBound(arr) + 1).Value = arr
Set datash = datash.Offset(1, 0)
End If
Loop
TS.Close
Next File
Final result that worked for me!
Sub SearchImportData1()
Dim FSO As Object
Dim SourceFolder As String
Dim Folder As Object
Dim Import As Range
Dim Search As String
Dim TextBox1 As TextBox
Dim File As Object
Dim TS As Object
Dim LineNumber As Integer
Dim Arr As Variant
SourceFolder = "C:\Users\MarMar\Desktop\Data\Census2016\DataFiles\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(SourceFolder)
Set Import = ActiveSheet.Cells(2, 3)
Search = ActiveSheet.TextBox1.Text
For Each File In Folder.Files
Set TS = File.OpenAsTextStream()
LineNumber = 0
Do While Not TS.AtEndOfStream
Arr = Split(TS.ReadLine, ",")
If Arr(0) = Search Then
Import.Resize(1, 1).Value = Arr(2)
Set Import = Import.Offset(1, 0)
End If
Loop
TS.Close
Next File
End Sub
I have a flat file with an unusual layout, where the data is stacked vertically. Each block of data begins with the same literal string, but the preceding lines of data vary between each array. The goal is to flatten out the result to single records. I am lost on how to accomplish this. Please help.
Example data from file:
Desired final layout in excel:
The regular expression of which i want to break each record out into its own row is PL_ID%. I just don't know enough about vba scripting to do it. Can someone point me in a direction?
Try this:
Sub flatToExcel()
Dim fileToOpen As String
Dim allData As String, parseData() As String
Dim currentRow As Integer
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> "" Then
Open fileToOpen For Binary As #1
allData = Space$(LOF(1))
Get #1, , allData
Close #1
End If
parseData() = Split(allData, vbCrLf)
currentRow = 0
For i = 0 To UBound(parseData(), 1) - LBound(parseData(), 1)
If Not parseData(i) Like "PL_ID*" Then
ThisWorkbook.Sheets(1).Cells(currentRow, Columns.Count).End(xlToLeft).Offset(0, 1).Value = parseData(i)
Else
currentRow = currentRow + 1
ThisWorkbook.Sheets(1).Cells(currentRow, 1).Value = parseData(i)
End If
Next i
End Sub
I've been using the code in this post to import several txt file. i want to put each value or string in one cell as array.but all of them put in one row so i have one column and several row.
the code is:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("G:\test")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, " ", 1)
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
Plz help me..
Thank you in advance
Here you are splitting the line and putting each token in different columns. If you don't want to split them, then remove these lines.
' Parse the line into | delimited pieces
Items = Split(TextLine, " ", 1)
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
And then just add back cl.Value = TextLine