Been working a project using recorded macros to complete copying and pasting between workbooks. Recorded macros has been working BUT, when reading the forums people are stating copy/paste method takes more time for macro to run and is very inefficient. So I'm trying to sound out a copy destination vba line that would copy several columns starting from Range(A2:G2000) and then paste to range area starting at (B6:H2000). I'm not good at this and trying to learn more efficiency. Two things here come to mind. A simple copy and paste method which I have working. BUT would utilize the straight source = destination. Could this be done? After reading this you may see another issue. Why have down to Row 2000 selected and copy/pasted? You are correct in your thinking. Some reports(txt files) have 100 rows, some 300, none more than 1000 but I'm overdoing the copy selection because I'm won't be sure about future txt files. I was thinking if you could just select the column down to the last row used would be cool. This is way beyond me. I'd be happy just a new way to copy/paste efficiently.
I would appreciate any help that anyone could offer. let me know what you think.
Thanks
Boomer
enter code here
Sub import_data()
'
'
'import_data
'
Application.ScreenUpdating = False
'
'Opens the txt file in excel - text delimited and leaves file open until
we close at bottom of code. There is no 'name for this workbook.
Workbooks.OpenText (Module33.FileDir + "\cf_data.txt"), Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1),
_
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)),
TrailingMinusNumbers:=True
'The line below is where I'm selecting data from the current opened
workbook and copying to another workbook
ActiveWindow.Sheet1.Range("A2:G2000").Copy
Destination:=Workbooks("Auto_Data.xlsm").Sheet2.Range ("B6:H2000")
'This info below is a (recorded marco). All works if I rem out the above
line and open up all the below lines
' Range("A2:G2000").Select
' Selection.Copy
' Windows("Auto_Data.xlsm").Activate
' Sheet2.Select
' Range("B6:H6").Select
' ActiveSheet.Paste
' Selection.AutoFilter
' Application.CutCopyMode = False
' ActiveWindow.ActivateNext
' ActiveWindow.Close
' Range("B4").Select
Application.ScreenUpdating = True
End Sub
A direct value transfer is typically faster than a copy and uses less memory since it doesn't involve the clipboard.
Sub import_data()
dim lr as long, arr as variant
dim wb1 as workbook
set wb1 = Workbooks.OpenText(filename:=Module33.FileDir & "\cf_data.txt"), Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)),
TrailingMinusNumbers:=True)
with wb1.sheets(1)
lr = .range("A:G").Find(what:="*", after:=.range("A1"), searchorder:=xlbyrows, _
searchdirection:=xlprevious).row
.range(.cells(2, "A"), .cells(lr, "G")).value
end with
wb1.close
Workbooks("Auto_Data.xlsm").Sheet2.Range("B6").resize(ubound(arr, 1), ubound(arr, 2)) = arr
end sub
Related
I have a little issue with my code.
The purpose is to get a specific range of data from each file, and to copy that range to another file's gathering sheet named "Extraction".
The issue is that my code didn't copy and paste every single peace of data range below the previous piece of data, as it should be. Can you please help me with that one and give me a correction/add for my code. Thank you in advance!
Here's the code :
Sub Extraction()
Dim FileNames As Variant
Dim i As Integer
Application.ScreenUpdating = False
Range("A2").Select
FileNames = Application.GetOpenFilename(FileFilter:="Excel Filter (*csv), *.csv", Title:="OpenFile(s)", MultiSelect:=True)
For i = 1 To UBound(FileNames)
Workbooks.Open FileNames(i)
'Separate
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)), TrailingMinusNumbers:=True
Range("F19:F42").Select
Selection.Copy
Windows("Wind Energy Monthly Forecast.xlsm").Activate
Sheets("Extraction").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=False
Workbooks.Open FileNames(i)
ActiveWorkbook.Close SaveChanges:=False
ActiveCell.Offset(1, 0).Activate
Next i
End Sub
I am trying to get my Text To Columns to work in my VBA script, but it's not working for me.
I understand how it works in excel and even used the macro record to get it working, but when adding it to my script nothing happens. I even looked at online forums. What I'm doing is extracting data from one workbook to the other and the data that I am getting needs to be converted to Text To Columns once the data is transferred to the other workbook.
I have two separate Sub functions that I used below: Neither of them worked. One of them is from the macro record and the other I found online.
Code from Macro Record below:
Sub TextToCol()
Selection.TextToColumns Destination:=Range("D3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
:="" & Chr(10) & "", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
TrailingMinusNumbers:=True
End Sub
Code from online forum below:
Sub TextToCol()
Selection.Range("D3:D8").TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Space:=True
End Sub
The code below is what I am using to connect to source workbook:
'Save Above Created New Workbook
sWorkbook.SaveAs Filename:="C:\Users\username\Desktop\fileName\Test.xlsx"
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
Set OpenBook = Application.Workbooks.Open(FileToOpen)
Below is the code to send data to the destination workbook:
Workbooks("Test.xlsx").Worksheets("Sheet1").Range("D" & counter).value = dataThatWasExtracted
What am I doing wrong?
I currently have a macro set up that allows me to paste data into column A from Textpad and then sorts, rounds, moves and saves the data as a txt file.
Is there anyway that I can modify the macro to allow me to import the txt file straight into Excel rather than having to copy and paste? The file names changes each time, but the file directory will stay the same.
This is the current macro I have that is run after manually copy and pasting the data into excel:
'Sub SortRoundandSave()
'
' SortTruncateandSave Macro
' This macro will sort, round and save your data
'
'
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D" & Range("B" & Rows.Count).End(xlUp).Row)
Range("A:A,B:B,D:D").Select
Range("D1").Activate
Selection.Copy
Sheets("Truncated Data").Select
ActiveSheet.Paste
Sheets("Truncated Data").Select
Application.CutCopyMode = False
Sheets("Truncated Data").Move
ChDir "G:\XXXX\Folder\Name\ZZZZ\Sort"
ActiveWorkbook.SaveAs Filename:= _
"G:\XXXX\Folder\Name\ZZZZ\Sort\Sorted Data.txt", _
FileFormat:=xlText, CreateBackup:=False
Windows("Excel Truncator.xlsm").Activate
End Sub
I assume it needs a few lines before the text to columns part, but I cant seem to get one to work?
Any help would be greatly appreciated.
Thanks
Try this:
Sub SortRoundandSave()
'
' SortTruncateandSave Macro
' This macro will sort, round and save your data
'
Dim workSht As Worksheet: Set workSht = ActiveSheet 'ThisWorkbook.Sheets("") ' Enter the name of sheet
Dim FilePath As String
Dim strLine As String
Dim rowCnt As Long
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the file"
.Filters.Clear
.Filters.Add Description:="Text Files", Extensions:="*.txt"
'.InitialFileName = "G:\XXXX\Folder\Name" ' Optional: this is a startup directory, place the correct one and uncomment line
If .Show = 0 Then Exit Sub
FilePath = .SelectedItems(1)
End With
rowCnt = 1
Open FilePath For Input As #1
Do While Not EOF(1)
Line Input #1, strLine
workSht.Cells(rowCnt, 1) = strLine
rowCnt = rowCnt + 1
Loop
Close #1
With workSht
Range(.Cells(1, 1), .Cells(rowCnt - 1, 1)).TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
.Cells(1, 4).AutoFill Destination:=Range(.Cells(1, 4), .Cells(workSht.Cells(Rows.Count, 2).End(xlUp).Row, 4)) ' "D1:D" & Range("B" & Rows.Count).End(xlUp).Row)
Range(.Cells(1, 1), .Cells(1, 4)).EntireColumn.Copy Sheets("Truncated Data").Cells(1, 1)
End With
Sheets("Truncated Data").Move
ActiveWorkbook.SaveAs Filename:= _
"G:\XXXX\Folder\Name\ZZZZ\Sort\Sorted Data.txt", _
FileFormat:=xlText, CreateBackup:=False
workSht.Parent.Activate
End Sub
I have around 30 files that I want to perform the same analysis on. Ideally, I want VBA to open all files and extract a certain (identical) piece of information. However, I don't know how to write a function for it. I was thinking of saving all the files as CSV and importing to python (a language I'm familiar with) which would make it easier for my data analysis. The reason I'm importing into excel is because python has difficulty reading .TX0 files (parsing line by line would be time consuming).
This is what i Have for the csv conversion. How do i translate this into the extraction of multiple files?
Sub TX0_CSV()
'
' TX0_CSV Macro
'
'
Workbooks.OpenText Filename:="X/.....fid002.TX0", Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
Range("A1:O13").Select
Range("O13").Activate
Selection.ClearContents
Rows("15:16").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=9
Range("A20:H29").Select
Range("H29").Activate
Selection.ClearContents
Range("J19").Select
ActiveWorkbook.SaveAs Filename:="X:\Joey\FID002.csv", FileFormat:=xlCSV, _
CreateBackup:=False
End Sub
You could convert it to a sub and then repeatedly call it.
Here is an example (Untested) Also note how we got rid of .Activate and .Select. You may want to see This
Sub ConvertFile(flName As String, newFileName As String)
Dim wb As Workbook
Dim ws As Worksheet
Workbooks.OpenText Filename:=flName, Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
Set wb = ActiveWorkbook
Set ws = wb.Sheets(1)
With ws
.Range("A1:O13").ClearContents
.Rows("15:16").Delete Shift:=xlUp
.Range("A20:H29").ClearContents
End With
wb.SaveAs Filename:=newFileName, FileFormat:=xlCSV
wb.Close (False)
End Sub
Example
Sub Sample()
ConvertFile "C:\Test1.dat", "C:\Test2.dat"
End Sub
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