Passing workbook object to a variable - excel

I have this code and it gives me a Compile error: Expected Function or Variable.
How do i code this properly.
Sub test()
Dim wb As Workbook
Dim FiletoOpen
FiletoOpen = Application.GetOpenFilename(filefilter:="Text Files (*.csv), *.csv", MultiSelect:=False)
Set csv_wb = Workbooks.OpenText(Filename:=FiletoOpen, startRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), 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)))
End Sub
If I use Set csv_wb = Workbooks.Open (FiletoOpen) it works fine.
But there are specific fields in the file that I need to be in Text format.
So I cannot use this. But when I use the above, it gives me the error.
Any help would be much appreciated.


You have declared wb but using csv_WB Try This.
UNTESTED
Sub test()
Dim csv_WB As Workbook
Dim FiletoOpen
FiletoOpen = Application.GetOpenFilename(filefilter:="Text Files (*.csv), *.csv", MultiSelect:=False)
If FiletoOpen = False Then Exit Sub
Workbooks.OpenText Filename:=FiletoOpen, startRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), 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))
Set csv_WB = ActiveWorkbook
End Sub

Related

Run Complicated Macro on Many Files

I have a large list of .txt files that I need to have a macro that does the following:
Open Files
Delimit the file based on "|"
Select all then filter
Sort on a specific header
Steps 3 and 4 are easy... If these files weren't all .txt with | delimiters, I know how to open multiple files and then filter/sort, the issue I run into is step 2.
Code so far:
Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
theDir = ThisWorkbook.Path
s = Dir(theDir & "\*" & ext)
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.txt*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
'your code here
Set r = Range(Range("A1"), Range("A1").End(xlDown))
r.TextToColumns Destination:=r, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, 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), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
s = Dir()
numFiles = numFiles + 1
xFileName = Dir
End With
Loop
End If
End Sub
This code works... but only for the first column, I have upwards of 70 columns in some documents.

You could use the Workbooks.OpenText method - a bit easier to manage I think
Sub Tester()
Dim wb As Workbook
Set wb = GetWorkbook("C:\Temp\pipes.txt")
Debug.Print wb.Name
End Sub
Function GetWorkbook(fpath) As Workbook
Workbooks.OpenText Filename:=fpath, Origin:=437, StartRow:= _
1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", TrailingMinusNumbers:=True
Set GetWorkbook = ActiveWorkbook
End Function

You are selecting the first column in this line of code.
Set r = Range(Range("A1"), Range("A1").End(xlDown))
This should be OK if the files are text delimited by the pipe symbol.
However if there are commas in the files, it will automatically break data after the comma into another column.
Try opening the files directly in text mode.
As an example
Workbooks.OpenText Filename:="C:\Temp\Test1.txt", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True

I got this to work:
Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
theDir = ThisWorkbook.Path
Dim wkbpath As String
Dim wkbname As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem) ' old version had: & "*.txt*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
'your code here
Set r = Range(Range("A1"), Range("A1").End(xlDown))
r.TextToColumns Destination:=r, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, 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), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
Cells.Select
Selection.AutoFilter
Application.AddCustomList ListArray:=Array("PREFERRED", "NON-PREFERRED", _
"UNACCEPTABLE", "OBSOLETE")
ActiveSheet.Sort.SortFields. _
Clear
ActiveSheet.Sort.SortFields. _
Add Key:=Range("D2:D479"), SortOn:=xlSortOnValues, _
CustomOrder:="PREFERRED,NON-PREFERRED,UNACCEPTABLE,OBSOLETE", DataOption:= _
xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:BH79")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
xFileName = Dir
wkbpath = "C:\Users\tomas.breitinger\Desktop\BAE Export .DAT Files\Finished\"
wkbname = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:= _
wkbpath & wkbname & ".xlsx", FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False
End With
End With
Loop
End If
End Sub

split cells format treatment

I use a simple macro, insert a "txt" file and then split it into columns
Sub POR_Import()
Dim ws As Worksheet, strFile As String
Call Smaz_vstup_POR
Set ws = ActiveWorkbook.Sheets("POR_IMPORT") 'set to current worksheet name
strFile = Application.GetOpenFilename("Text Files (*.*),*.*", , "Please select text file...")
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
Call SplitPOR
i = MsgBox("Done", vbOKOnly + vbInformation)
End With
End Sub
and split
Sub SplitPOR()
Sheets("POR_IMPORT").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("POR_divide").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="¦", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12 _
, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), _
Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array( _
25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), _
Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array( _
38, 2), Array(39, 2), Array(40, 2), Array(41, 1), Array(42, 2), Array(43, 2), Array(44, 2), _
Array(45, 2), Array(46, 2), Array(47, 2), Array(48, 2), Array(49, 2), Array(50, 2), Array( _
51, 2), Array(52, 2), Array(53, 2), Array(54, 2), Array(55, 2), Array(56, 2), Array(57, 2), _
Array(58, 2), Array(59, 2), Array(60, 2), Array(61, 2), Array(62, 2), Array(63, 2)), _
TrailingMinusNumbers:=True
End Sub
But every time I want to repeat the process I have to close and reopen excel. The moment you insert the txt for the second time excel will automatically split it according to how it was split the first time.
Is there please any possible treatment for this case?

Apologize once more for being obtuse and not understanding what you meant!
Please, try using the next optimized solution:
Sub POR_Import()
Dim ws As Worksheet, strFile As String
Call Smaz_vstup_POR
Set ws = ActiveWorkbook.Sheets("POR_IMPORT") 'set to current worksheet name
ws.UsedRange.ClearContents 'clear the previous used range content
'Normalize the TextToColumns behavior:____________________________________________________________
With ws.Range("A1")
.value = "1,2,3"
.TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.ClearContents
End With
'____________________________________________________________________________________________
strFile = Application.GetOpenFilename("Text Files (*.*),*.*", , "Please select text file...")
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileTabDelimiter = True
.Refresh
End With
ws.QueryTables(ws.QueryTables.count).Delete 'delete the query after bringing the necessary text
SplitPOR ws 'call the splitting function with ws sheet as argument
MsgBox "Done", vbOKOnly + vbInformation
End Sub
Sub SplitPOR(ws As Worksheet)
Dim wsP_d As Worksheet, arrtxt(62), i As Long
Set wsP_d = Worksheets("POR_divide")
wsP_d.UsedRange.ClearContents 'clear the content, to not be ask about overwriting
wsP_d.Range("A:A").value = ws.Columns("B:B").value 'copy the column without using clipboard
For i = 0 To UBound(arrtxt) 'create the array to be passed to FieldInfo TextToColumns parameter
arrtxt(i) = Array(i + 1, 2)
Next i
'Use a more compact way:
wsP_d.Range("A:A").TextToColumns Destination:=wsP_d.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, space:=False, Other:=True, OtherChar _
:="¦", FieldInfo:=arrtxt, TrailingMinusNumbers:=True
End Sub
Please, send some feedback after testing it. I will feel better knowing that I could help, after my stupid approach in comments, not being able to understand how what you were saying was possible...

Cells are treated as text after input from file

I create a script in VBA that copy data from txt to spreadsheet, but cells are treated like a text even after formatting them to percent or number:
Sub PasteTextFileContent()
Dim wbExcel As Workbook, wbText As Workbook
Dim wsExcel As Worksheet
Set wbExcel = ThisWorkbook
Set wsExcel = wbExcel.Sheets("PastData")
Set wbText = Workbooks.Open("C:\Test\test.txt")
wbText.Sheets(1).Cells.Copy wsExcel.Cells
wbText.Close SaveChanges:=False
Sheets("PastData").Visible = True
Sheets("PastData").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, 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)), _
TrailingMinusNumbers:=True
Sheets("PastData").Visible = False
End Sub
I input data to text with:
Sub ToTxtFileSimpleButWorkingWell()
Dim strFile_Path As String
strFile_Path = "C:\Test\test.txt"
Open strFile_Path For Append As #1
Write #1, Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss"), Sheets("DASHBOARD").Range("V1").Value, Sheets("DASHBOARD").Range("V2").Value, Sheets("DASHBOARD").Range("V3").Value, Sheets("DASHBOARD").Range("V4").Value, Sheets("DASHBOARD").Range("V5").Value, Sheets("DASHBOARD").Range("V6").Value, Sheets("DASHBOARD").Range("V7").Value
Close #1
End Sub
How can I change that?

VBA code to convert all data to columns with arbitrary number of delimiters

I would like to have a macro for converting a pipe-delimited csv/text file to to columns. When I recorded the macro, it tailored it to the number of columns in this dataset. How do I alter this code so that it accommodates any number of columns?
Sub Pipe2Col()
'
' Pipe2Col Macro
'
' Keyboard Shortcut: Ctrl+t
'
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
DisplayAsIcon:=False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, 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), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
25, 1), Array(26, 1), Array(27, 1), Array(28, 1)), TrailingMinusNumbers:=True
End Sub

Simplist way would be to prebuild a FieldInfo array that you know is larger than the max number of columns in your source data
Here I've assumed that is 100 columns. Also cleaned up the recorder nonsense
Sub Demo()
Dim ws As Worksheet
Dim rng As Range
Dim FieldInfo() As Variant
Dim ColInfo() As Variant
Dim i As Long
Set ws = ActiveSheet
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))
ReDim FieldInfo(0 To 99)
ReDim ColInfo(0 To 1)
ColInfo(1) = 1
For i = 1 To 100
ColInfo(0) = i
FieldInfo(i - 1) = ColInfo
Next
rng.TextToColumns _
Destination:=rng.Cells(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="|", _
FieldInfo:=FieldInfo, _
TrailingMinusNumbers:=True
End Sub

Modify recorded code to convert Text to Column

I have a column BA. I want to do Text to Column to column BC.
I recorded a macro. When I execute it in a workbook I get an error.
Here is my recorded macro.
Sub Macro8()
'
' Macro8 Macro
'
' Keyboard Shortcut: Ctrl+Shift+H
'
Selection.TextToColumns Destination:=ActiveCell.Offset(0, 2).Range("A1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
:=True, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, _
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), Array(22, 1), Array( _
23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), _
Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array( _
36, 1), Array(37, 1), Array(38, 1)), TrailingMinusNumbers:=True
End Sub
Shouldn't Range be BA?
I don't see BC - is that the 0, 2 offset?

EDIT: changed the destination offset to two columns over (from 1)
If you just need your code to operate on the selected cells then this should work:
Selection.TextToColumns Destination:=Selection.Offset(0, 2), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Comma:=True, Other:=True, _
OtherChar:=":"
Unless you have specific datatypes etc you want to apply to the resulting columns, you can typically omit the FieldInfo argument

Resources