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
Related
I have a issue with copy/paste the data from one file to another after i changed the range of rows to be transferred. Until now i used a file with 147 rows and 6 columns, no i have to use a file with 579 rows in 6 columns. But when i try to transfer the data with the 549 rows i got the message : "There is already data here. Do you want to replaced it". It is very annoying and i don't know what's happening, while the data is in the same format, only the rows are much more. I think the Separate part is the problem, but not sure. Here's the part of the code, making that issue :
Sub OpenF()
Dim Window As String
Dim sPath As String
Dim VarName As String
Dim GetBook As String
Dim sFile As String
VarName = Sheet1.Range("a4").Value
Window = VarName & "FileName_3_15min.csv"
ChDir sPath & "\Schedule"
' Open the fail
sFile = sPath & "\Schedule\" & Window
If Dir(sFile) = "" Then
MsgBox "File: (" & Window & ") is missing"
Else
Workbooks.Open Filename:= _
sPath & "\Schedule\" & Window
Cells.Select
Selection.Copy
Windows(GetBook).Activate
Sheets("Sheet.5").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'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
Sheets("WindFarmBalchik_2.1").Columns("A:G").AutoFit
' Close the fail
Windows(Window).Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
End if
End Sub
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
my task is:
1) Select all cells in A row which contain values (done).
2) Text to Columns - example value 2017.01.01
Sub selectAndToColumns()
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LR).SpecialCells(xlCellTypeConstants, 23).Select
'2nd step
Selection.TextToColumns Destination:=Range(A1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1))
End Sub
1 step is ok, but how can I use my selection instead of Range(A1) in 2nd step? Can I make a variable and how?
I'm not too sure about your requirements, but this will perform the TextToColumns without selecting anything (You can still change the destination to wherever you want the resulting data to be placed, you can do this by specifying a range or even using a variable where your range is stored):
Sub selectAndToColumns()
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LR).SpecialCells(xlCellTypeConstants, 23).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1))
End Sub
UPDATE
If you want to replace your destination with a variable instead of Range("A1") then something like below will work:
Sub selectAndToColumns()
Dim DestinationRange As String
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
DestinationRange = "D1"
MsgBox DestinationRange
Range("A1:A" & LR).SpecialCells(xlCellTypeConstants, 23).TextToColumns Destination:=Range(DestinationRange), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1))
End Sub
I'm not sure if I have understood your question properly, but if you just want to select Column A and paste it as values, I would use:
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
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 am looking to import data from several excel files located in the same folder. New files are added to the folder daily. I import the data once a week or month and need a loop that imports all data from files I haven't already imported from. Currently I have the following code I use, but I have to go in and retype the filename for every file to get new data. Help please?
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="H:\global\Prosjekt\NAS\RCL\OUTPUT-20150302.csv"
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("yield1.xlsm").Activate
Sheets("Input").Select
Range("A9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A9"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, 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), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
Windows("OUTPUT-20150302.csv").Activate
ActiveWindow.Close
'XYZ
Sheets("Input").Select
Range("R8:R204").Select
Selection.Copy
Sheets("XYZ").Select
Range("xfd1:xfd197").End(xlToLeft).Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
This is probably what you wanted:
Durgun's answer in code:
Dim CurrentFilePath As Variant '<-- ADDED
Dim wkbOpenedWorkbook As Workbook '<-- ADDED
Dim SelectionB4 as Range '<-- ADDED
Const sDIR As String = "H:\global\Prosjekt\NAS\RCL\*.csv" '<-- ADDED, note: "*.csv" is filter for your files
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set SelectionB4 = Range(Selection, Selection.End(xlDown))'<-- moved/changed, save reference to your 1 selection
CurrentFilePath = Dir(sDIR) '<-- ADDED
While CurrentFilePath <> "" '<-- ADDED
Set wkbOpenedWorkbook = Workbooks.Open(Filename:=CurrentFilePath) '<-- CHANGED, save reference to workbook, to close it later
SelectionB4.Select
Selection.Copy
Windows("yield1.xlsm").Activate
Sheets("Input").Select
Range("A9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A9"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, 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), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
wkbOpenedWorkbook.Close False '<-- CHANGED 'close and dont save, remove "False" to popup the save dialog
'XYZ
Sheets("Input").Select
Range("R8:R204").Select
Selection.Copy
Sheets("XYZ").Select
Range("xfd1:xfd197").End(xlToLeft).Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
CurrentFilePath = Dir(sDIR) '<-- ADDED
Wend '<-- ADDED
Note: there are many places in code to optimize, make more stable, faster, readable.
In VBA there is a function named Dir(pathname, attributes).
You can find the reference here : Function Reference
You are going to define a FileList as Variant and then set it with Dir function like this : FileList = Dir("c:\YourFolder\)
After that you can iterate through FileList for the Excel Files with a loop like this While (FileList <> "")
After reading file you can store which files you read in a text file so that you will not encounter with duplications.