I want to enhance my current VBA Macro which exports data from one place to another by removing all rows that have Zero Amount in column G. Can someone show me what VBA script i need to add in my current script to do this?
Here is my script now:
Sub ExportFees()
'
' ExportFees Macro
' Mgt Fee Import
'
Dim Filename As String
Filename = Worksheets("Tradar Import").Range("Y8")
Columns("A:W").Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"\\BET-SYD-SVR01\Betashares\Ops\Tradar Import\FEE001\" & Filename, FileFormat _
:=xlCSV, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
Original Data Source
If you set a range reference to the data then you can use Range.AutoFilter to filter the data and Range.Copy to copy the filtered data to a destination range.
Sub ExportFees()
'
' ExportFees Macro
' Mgt Fee Import
'
Dim Filename As String
Dim DataRange As Range
Set DataRange = Range("A1").CurrentRegion
DataRange.AutoFilter Field:=7, Criteria1:="<>0", Operator:=xlAnd
DataRange.AutoFilter
Filename = Worksheets("Tradar Import").Range("Y8")
Workbooks.Add
DataRange.Copy Destination:=Range("A1")
ActiveWorkbook.SaveAs Filename:= _
"\\BET-SYD-SVR01\Betashares\Ops\Tradar Import\FEE001\" & Filename, FileFormat _
:=xlCSV, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
Related
I'm still new to VBA. I need to extract one worksheet with formulas to a new workbook as pasted value. Save it to the another folder with the same name but adding "hc" at the end for hard copy. Also, the tab name should still stay the same from worksheet to workbook. I found a formula that is similar to what I need but I don't know how to modify it so it would save to a specific folder or how to modify the name. Can someone help me please?
Thank you
Sub ExporthisBOM()
Dim fName
Sheets("Radiant_Trades").Copy
With ActiveSheet
.UsedRange.Copy
.Cells(1, 1).PasteSpecial xlPasteValues
.Cells(1, 1).PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
fName = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As")
ActiveWorkbook.SaveAs Filename:=fName
End Sub
The above formula works. Also, one to modify name but I don't understand how you can combine them or if there is an easier way to do everything I want.
Sub sbVBS_To_SaveAs_ActiveWorkbook()
ActiveWorkbook.SaveAs "C:temptest1.xlsx"
End Sub
try this, this will save your current workbook's name and add "hc" at the end
for example your workbook name = "book1.xlsx" then the output will be "book1 hc.xlsx"
Sub ExporthisBOM()
Dim fName As String
fName = Left(Application.ActiveWorkbook.Name, Len(Application.ActiveWorkbook.Name) - 5)
Sheets("Radiant_Trades").Copy
With ActiveSheet
.UsedRange.Copy
.Cells(1, 1).PasteSpecial xlPasteValues
'.Cells(1, 1).PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="" & fName & " hc " & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End Sub
I am trying to create VBA code that will select the Date, Day and Gas Usage columns (as depicted below) for the current day and the following ten days (TODAY()+10) (as highlighted in red by the below picture). Where this range can be copied and exported into a new csv file.
The code below performs this action of extracting a range and exporting it as a new csv, however, it only selects a static range (A1:C10). How can I edit the code so that when the VBA is run it will select these columns for the next ten days on any given day that this code is run.
Sub CreateCSV()
Range("A1:C10").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\lach\Desktop\Test\data" & Format$(Now, "yyyyMMddhhmmss") & ".csv", FileFormat:= _
xlCSV, CreateBackup:=False
End Sub
Assuming your days are sequential, without gaps, you can use Application.Match to find the date and Resize to select that cell plus the next 10 rows.
Dim r As Variant
' Find the date in column A
r = Application.Match(CLng(Date), Range("A:A"), 0)
' Only proceed if date has been found
If Not IsError(r) Then
Dim wb As Workbook
Set wb = Workbooks.Add()
ThisWorkbook.Worksheets("SheetName").Cells(r, 1).Resize(11, 3).Copy _
Destination:=wb.Worksheets(1).Range("A1")
wb.SaveAs _
Filename:= "C:\Users\lach\Desktop\Test\data" & Format$(Now, "yyyyMMddhhmmss") & ".csv", _
FileFormat:= xlCSV, _
CreateBackup:=False
End If
I'm working on a Macro that makes several CSV files from a certain area while applying a filter. There are two issues.
The workbook will be saved as a file-format retrieved from it's name (cell B15 and the word 'Week')
I cannot find a way to loop this Macro until Cell B15 is empty.
Can anyone help? Thanks in advance.
Example wrong format:
Sub CSVMaker()
'
' CSVMaker Macro
'
'
ActiveSheet.Range("$A$17:$M$240000").AutoFilter Field:=2, Criteria1:="<>"
Range("A18:B18").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add.Name = Range("A10").Value & "." & Range("A7").Value & "." & "Week" & Range("B15").Value
ActiveSheet.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
Sheets("Input").Select
Columns("B:B").Select
Range("B6").Activate
Selection.Delete Shift:=xlToLeft
End Sub
So finally the answer is the filename needs a correct extension like Filename:=ActiveSheet.Name & ".csv".
And I recommend to avoid .Select and do the following:
Option Explicit
Public Sub CSVMaker()
Dim ws As Worksheet
Set ws = ActiveSheet 'better ThisWorkbook.Worksheets("your-sheet-name")
ws.Range("$A$17:$M$240000").AutoFilter Field:=2, Criteria1:="<>"
ws.Range("A18:B18", ws.Range("A18:B18").End(xlDown).End(xlDown)).Copy
Dim SheetName As String
SheetName = ws.Range("A10").Value & "." & Range("A7").Value & "." & "Week" & Range("B15").Value
ThisWorkbook.Sheets.Add.Name = SheetName
ThisWorkbook.Sheets(SheetName).Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SheetName).Copy
ActiveWorkbook.SaveAs Filename:=SheetName & ".csv", FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
ThisWorkbook.Sheets("Input").Columns("B:B").Delete Shift:=xlToLeft
End Sub
I am not familiar with VBA so please forgive the simplicity of this question. I have a recorded macro which selects, opens then saves a file from a hyperlink in one of my columns. I just want to make a loop to repeat this macro down all of the rows in the worksheet which have data in them. Below is the code for the recorded macro, thank you all for your assistance.
Sub Extract()
'
'Extract Macro
'
'
Range("D2").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Workbooks.Open Filename:= _
"https://channele.corp.etradegrp.com/communities/teams02/performance-monitoring/TPEF%20Library/A2Consulting_Tech_5650_VSAF.xlsm"
ActiveWindow.Visible = False
Windows("A2Consulting_Tech_5650_VSAF.xlsm").Visible = True
ChDir "O:\Procurement Planning\QA"
ActiveWorkbook.SaveAs Filename:= _
"O:\Procurement Planning\QA\Copy of A2Consulting_Tech_5650_VSAF.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
End Sub
Something like this might work already:
Sub Extract()
Dim RngTarget As Range
Dim StrFileName As String
Set RngTarget = Range("D2")
Do Until RngTarget.Value = ""
RngTarget.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Workbooks.Open Filename:=RngTarget.Value
StrFileName = Split(RngTarget.Value, "/")(UBound(Split(RngTarget.Value, "/")))
Windows(StrFileName).Visible = True
Workbooks(StrFileName).SaveAs Filename:="O:\Procurement Planning\QA\Copy of " & Split(StrFileName, ".")(0) & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
Workbooks(StrFileName).Close
Set RngTarget = RngTarget.Offset(1, 0)
Loop
End Sub
I have an Excel macro (own recorded), which does following:
in the column A (A1-A90) are placed different formulas. Formula calculation is set to manual.
The macro
copies formula from A1
creates new file
pastes formula into A1 of newly created file
calculates the formel
saves the file
The macro code is:
Sub Makro1()
'
' Makro1 Makro
'
Windows("macrotest.xlsx").Activate
Range("A1").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\Mappe1.csv", FileFormat:=xlCSV, _
CreateBackup:=False
Windows("macrotest.xlsx").Activate
Range("A2").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\Mappe2.csv", FileFormat:=xlCSV, _
CreateBackup:=False
Windows("macrotest.xlsx").Activate
Range("A3").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\Mappe3.csv", FileFormat:=xlCSV, _
CreateBackup:=False
End Sub
I have more then 100 formulas, so it would be nice to have two loops in the macro instead of paste 100 code snippets into macro code:
one loop would take formulas from the range A1-A90 one by one to paste into created files
second loop would give forthcoming file names on saving files (not important, which names - 1.csv to 100.csv is fully enough).
Please point me to right loops.Thanks.
Upd:
Based on advice from Tim Edwards i build up this macro:
Sub MyMacro()
Dim i As Integer, myname As String
myname = ThisWorkbook.Name
For i = 1 To 90
Windows(myname).Activate
Range("A" & i).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveSheet.Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\file" & i & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.Close True
Next i
End Sub
But the problem on it is, that the formulas in saved files aren't calculated - i get only the pasted formulas into a1.
Does somebody see the cause, why formulas aren't calculated before saving? I tried all kinds of formula calculation setting - automatic, manual, manual on saving.
Sub Makro1()
Dim i as integer
For i = 1 to 100
Windows("macrotest.xlsx").Activate
Range("A" & i).Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= "Z:\Mappe" & i & ".csv", FileFormat:=xlCSV, CreateBackup:=False
Next i
End Sub
Make one loop going from 1 to 90.
For i = 1 To 90
Next i
In each iteration:
Get the formula from Cells(i, 1).
Paste into a new workbook and calculate.
Save the workbook as "directory.." + i +".csv".