Related
We have a mission critical spreadsheet that imports a lot of flat text from a desgin program and then brings it in to this spreadsheet.
We recently updated the design software, which we do once a year and have done so in my 12 years here. This year, they made a change to a file where it placed the header of a column of text in a different place. Now, our program will not import it correctly. It is the PART column...
Old text file:
New Text File...
So as you can see, they moved PART to the lower left.
Not being an expert in VBA, I am struggling to find exactly where I need to modify the code to bring it in properly..
This is the section of VBA code where I do think the selections are made but nothing specifies PART in the code...perhaps it is part of the Array? The file is called CZE_DET.OUT.
Sub IMPORT_CZEOUT()
Dim aryJobs() As String
Dim strComb As String
Dim strDir As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Sheets("CEE ORDER").Visible = True
Sheets("CZE_DET").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("CEE ORDER").Select
For i = 1 To colAllBuildings.Count
strDir = Dir$(colAllBuildings.Item(i) & "\CZE_DET.OUT")
If strDir <> "" Then
Workbooks.OpenText Filename:=colAllBuildings.Item(i) & "\CZE_DET.OUT", Origin:=xlWindows, _
StartRow:=7, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
Array(28, 9), Array(35, 9), Array(47, 9), Array(54, 1), Array(57, 1), _
Array(62, 1), Array(67, 1), Array(72, 1))
Range("A1:L" & CStr(Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)).Select
Selection.Copy
Windows(strShipperName).Activate ' This line does not work, for NO reason!
' Windows(1).ActivatePrevious
Sheets("CZE_DET").Select
Range("A1").Select
If Range("A1").Value <> "" Then
ActiveSheet.Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlValues
Selection.Sort Key1:=Range("A12"), Order1:=xlAscending, Orientation:=xlTopToBottom
Windows("CZE_DET.OUT").Activate
ActiveWindow.Close
End If
Next
I would post the spreadsheet but it attaches the VBA though an XLA file through a network share. And the XLA file is protected and I can't seem to rename it and remove password to send a link.
I posted the entire subroutine here as I only posted where I thought t the problem would be: https://pinnaclestructures365-my.sharepoint.com/:f:/g/personal/bwolters_pinnaclestructures_com/EpGrxtGx4_BCgL4nl3QDZxcBalaRSL52pI0S8UNX0n6kOg?e=0oyh2k
Any suggestions?
Here is a re-worked example of how to make your references more explicit.
Sub IMPORT_CZEOUT()
Dim aryJobs() As String
Dim strComb As String
Dim strDir As String
Dim i As Integer, cDest As Range
Dim j As Integer, fName As String, rngData As Range, lRow As Long
Dim k As Integer, wb As Workbook, wbSrc As Workbook, wsSrc As Worksheet
Set wb = Workbooks(strShipperName) 'The wb where data is to be collected
'Include the file extension!
wb.Sheets("CEE ORDER").Visible = True
wb.Sheets("CZE_DET").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = 1 To colAllBuildings.Count
fName = colAllBuildings.Item(i) & "\CZE_DET.OUT"
If Len(Dir(fName)) > 0 Then
Workbooks.OpenText Filename:=fName, Origin:=xlWindows, _
StartRow:=7, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
Array(28, 9), Array(35, 9), Array(47, 9), Array(54, 1), Array(57, 1), _
Array(62, 1), Array(67, 1), Array(72, 1))
Set wbSrc = ActiveWorkbook 'source data workbook
Set wsSrc = wbSrc.Worksheets(1) 'source data sheet
lRow = wsSrc.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set rngData = wsSrc.Range("A1:L" & lRow) 'all source data
With wb.Worksheets("CZE_DET") 'EDIT
Set cDest = .Cells(.Rows.Count, "A").End(xlUp)
End With
If Len(cDest.Value) > 0 Then Set cDest = cDest.Offset(1)
cDest.Resize(rngData.Rows.Count, rngData.Columns.Count).Value = rngData.Value
'not sure about this line....
Selection.Sort Key1:=Range("A12"), Order1:=xlAscending, Orientation:=xlTopToBottom
wbSrc.Close savechanges:=False 'close the source file
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
EDIT - as pointed out in a comment, the length of one of the fileds has increased by 1 character, so the FieldInfo argument needs to be updated:
Workbooks.OpenText Filename:=fName, Origin:=xlWindows, _
StartRow:=7, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
Array(28, 9), Array(35, 9), Array(47, 9), Array(55, 1), Array(58, 1), _
Array(63, 1), Array(68, 1), Array(73, 1))
The open statement could be simplified as the skipped fields (type=9) are the blanks and values are trimmed on import.
Workbooks.OpenText Filename:=s, Origin:=xlWindows, _
StartRow:=7, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(4, 1), Array(18, 1), Array(27, 1), _
Array(35, 1), Array(54, 1), Array(58, 1), _
Array(63, 1), Array(68, 1), Array(73, 1))
Tested with this text file
line 1
line 2
line 3
line 4
line 5
line 6
ish description part punch comment qnt feet inch 16th mark
--- ------------- -------- ------- ------------------ --- ---- ---- ---- ------
xxx 8.0x3.5 c 12 8x35c12 psu-psu see drawing ec-1 28 16 8 3 ec-1
xxx 8.0x3.5 c 12 8x35c12 psu-psu see drawing ec-1 28 16 8 3 ec-1
xxx 8.0x3.5 c 12 8x35c12 psu-psu see drawing ec-1 28 16 8 3 ec-1
a-z a-----------z a----- z a-----z a----------------z a-z a--z a--z a--z a----z
I am trying to copy multiple txt file into excel but having a little issue on the following:
Sub devise(FICHIER, FEUILLE)
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(FEUILLE)
Dim wbcopy As Workbook
ChDir "R:\Oco_R\Valoco"
Workbooks.OpenText Filename:="R:\Oco_R\Valoco\" & FICHIER, Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(6, 1), Array(26, 1), Array(35, 1), Array(46, 1), _
Array(53, 1), Array(64, 1), Array(72, 1))
Selection.Copy
ws.Activate
ws.Range("A1").PasteSpecial
'ActiveSheet.Paste
ws.Rows("1:4").Delete Shift:=xlUp
ws.Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
Application.CutCopyMode = False
ActiveWorkbook.Close
End Sub
I already defined the workbook where I would like the txt to be copied to. But I was wondering how I could DIM the txt file so that I can close it? For example FIHCIER.close, but doesn't work of course...
In the code I'm using ActiveWorkbook.Close but it is referring to my excel file which I don't want to close.
I tried using a Set wbC but haven't really succeeded...
Thank you very much for your help!
When you open a textfile using Workbooks.OpenText, Excel will create a workbook (containing one sheet) from the text file.
For some strange reasons OpenText is not implemented as function (in opposite to Workbooks.Open`), so you can't do something like
set txtFile = Workbooks.OpenText(MyTextFileName)
However, after you open the file, it is automatically the ActiveWorkbook, so you can do the following:
Dim txtFile as Workbook
Workbooks.OpenText filename:=MyTextFileName
Set txtFile = ActiveWorkbook
(...)
txtFile.close saveChanges:=False
I have some vba code which loops through all csv-files in a folder. It saves a file but does not split text into columns.
When I step through the code using F8, I can see that the text is split to columns, but when reopening the modified file I can't see the text having been split.
I am trying to open each file, split text to columns, and then save and go to the next file. I want to this for all files in a folder of my choice. Each folder may contain thousands of files.
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.csv*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _
"|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1) _
, Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array( _
19, 1), Array(20, 1), Array(21, 1)), TrailingMinusNumbers:=True
Range("A1").Select
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
You may be saving the file back to csv. You should save the file in xlsx, this way:
wb.SaveAs Filename:=split(myfile, ".")(0), FileFormat:=xlOpenXMLWorkbook
And please apply #Luuklag's suggestion, too.
I have 3 csv files which I have to merge and but before that I have to prepare then to have same columns order. All works fine except for I cannot figure out so far how change order of columns in output file. I can select columns which I want and other skips fine but what if I want to swap some? I thought that putting in proper order in fieldinfo array would do the trick but no. I want to swap 8 with 6.
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=Filenamenew, Origin:=xlWindows, StartRow _
:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 3), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 9), Array(8, 1), Array(7, 9), Array(6, 1))
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=LBname, FileFormat:=FileFormatNum, _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
Wb.Close savechanges:=False
thanks
The best way to do this is to change the output of whatever is creating the CSV file you need to change. I assume you don't have access to that for whatever reason, so this will get the job done:
Sub swapColumns(first As Integer, second As Integer)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("C:\root\test.csv")
Set ws = wb.Sheets(1)
If first > second Then
Dim i As Integer
i = first
first = second
second = i
ElseIf first = second Then
Exit Sub
End If
ws.Columns(second).Cut
ws.Columns(first).Insert Shift:=xlToRight
ws.Columns(first + 1).Cut
ws.Columns(second + 1).Insert Shift:=xlToRight
End Sub
You can call this Sub from your existing code with swapColumns 6, 8
I managed to create a macro using the "record macro" function in Excel.
The problem is I have multiple CSV files and the recorded macro has the ActiveSource hard-coded in. How can I run a macro on any CSV without hard-coding the title of the sheet?
Also I do not want to use fixed columns as in the example below. I want to select columns based on the title of the column. So for example, if the column header in A1 is volts, then I want column A in the graph.
Sub CreateThermalPlot()
'
' CreateThermalPlot Macro
' Create new thermal plot of .csv that contains Reported CPU temp, Diode Temp, and Td.
'
' Keyboard Shortcut: Ctrl+j
'
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1)), _
TrailingMinusNumbers:=True
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("A:A,T:T,U:U,W:W").Select
Range("W1").Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range( _
"monitor_ENGtrevorSBTSITND_4910_!$A:$A,monitor_ENGtrevorSBTSITND_4910_!$T:$T,monitor_ENGtrevorSBTSITND_4910_!$U:$U,monitor_ENGtrevorSBTSITND_4910_!$W:$W" _
)
ActiveChart.Location Where:=xlLocationAsNewSheet
End Sub
You can open up all the files you want to work with dynamically, too. Here there is no need to hardcode anything in either VBA or in your worksheet plus you can have one master xlsm file which can work with lots of files at once.
Function SelectFilesToWorkWith() As Collection
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim files As New Collection
With fd
.AllowMultiSelect = True
.Show
For Each file In .SelectedItems
files.Add (file)
Next file
End With
Set SelectFilesToWorkWith = files
End Function
Sub work()
Dim filesToWorkWith As New Collection
Set filesToWorkWith = SelectFilesToWorkWith
Dim CSVfile As String
For Each CSVfile In filesToWorkWith
Workbooks.Open (CSVfile)
'...do work with file
Next CSVfile
End Sub
For your first issue, using a filepath/filename selected at run time, i would have a cell on the first sheet of the workbook into which i pasted the file name and path, probably Sheet1 cell A1, then i would use
ActiveSheet.QueryTables.Add(Worksheets("Sheet1").range("A1").value,Destination:=Range("$A$1")).TextFileCommaDelimiter = True
You may need to adjust more properties as you see fit (try recording a macro that uses the Data → From Text feature if you are unsure of what properties you care about or how to specify them).
For your second issue, if the names of the columns are always going to be exactly the same, no changes in spelling, and they will always been in the top row, then what i tend to do is use a For loop with a Case Select. Here's some of my code:
'Loop through all the columns to find the ones we want to graph
For j = 2 To act_cols
Select Case ws.Cells(1, j).value
Case "FT410": ft410_col = j
Case "FT410FlowCheck": ft410check_col = j
Case "VSD410": vsd410_col = j
Case "Set Point": sp_col = j
Case "% Error (Avg)": error_avg_col = j
End Select
Next j
Your third issue should probably have its own post with a bit more detail.
Hope that helps a bit.