I have the following problem: After I start opening a workbook that I have just created, the code stops running with no error. Have anyone a solution how the rest of the code can be excuted?
Thanks in Advance!
Private Sub CommandButton3_Click()
On Error GoTo Eingabefehler
Application.DisplayAlerts = False
ActiveSheet.Select
Range("A1").Select
ActiveSheet.Paste
ThisWorkbook.Save
Dim strPath As String
Dim strName As String
UserForm1.Show
strPath = "C:\Users\Desktop\"
strName = Application.GetSaveAsFilename(InitialFileName:=strPath & ".xlsx", FileFilter:="XLSX-File (*.xlsx), *.xlsx")
ActiveWorkbook.SaveAs Filename:=strName, FileFormat:=xlOpenXMLWorkbook
Dim WbDatei1 As Workbook
Dim WbDatei3 As Workbook
Set WbDatei1 = ThisWorkbook
Set WbDatei3 = Workbooks.Open(strName) 'VBA Code stops working from here
For Each shp In WbDatei3.Sheets(1).Shapes
shp.Delete
Next
WbDatei3.Save
WbDatei1.Sheets(1).Select
Selection.Columns("F:F").EntireColumn.AutoFit
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(TIME(HOUR(RC[-2]-RC[-5]),MINUTE(RC[-2]-RC[-5]),SECOND(RC[-2]-RC[-5])),"""")"
[...]
Related
I have a macro in workbook A that calls a macro in workbook B. I want the macro in workbook B to run and then I want to close workbook B. I keep getting an error saying the macro cannot be found that I want to run from workbook B. I am pretty much a novice at this, but I have done a pretty thorough search and haven't been able to come up with anything on my own. Here is my code in it's entirety.
Public Sub InputDept()
Dim Cap As Workbook
Dim Cap2 As String
On Error Resume Next
Set Cap = Workbooks("NGD Source File for Net Budget Reporting.xlsx")
Cap2 = Cap.Name
On Error GoTo 0
Dim wb As Workbook
Dim Cap1 As Variant
Application.ScreenUpdating = False
If Cap Is Nothing Then
Cap1 = Application.GetOpenFilename("Excel Files(*.xl*)," & "*.xl*", 1)
If Cap1 = False Then
Exit Sub
End If
Set wb = Workbooks.Open(Cap1)
Cap2 = ActiveWorkbook.Name
Else
Workbooks(Cap2).Activate
End If
Sheets("Dept Summary").Activate
Cells.Find(What:="Direct", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Dim cRng As Range
Dim dRng As Range
Set dRng = Selection
For Each cRng In dRng
If cRng.Interior.ThemeColor = xlThemeColorAccent3 Then
Dim mCalc As String
Dim mSum As Workbook
On Error Resume Next
Set mSum = Workbooks("Master Calc with Macro.xlsm")
mCalc = mSum.Name
On Error GoTo 0
Application.ScreenUpdating = False
If mSum Is Nothing Then
mSum1 = Application.GetOpenFilename("Excel Files.xl*),"& "*.xl*", 1)
If mSum1 = False Then
Exit Sub
End If
Set wb1 = Workbooks.Open(mSum1)
mCalc = ActiveWorkbook.Name
Else
Workbooks(mCalc).Activate
End If
cRng.Copy
Workbooks(mCalc).Activate
Sheets("Data").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Report").Activate
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
Sheets("Report").Select
ActiveSheet.Copy
Cells.Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs _
Filename:=Application.ThisWorkbook.Path & "\" & Format(Date - 28, "MMM") & " Files\" & Left(cRng, 7) & ".xlsx"
ActiveWorkbook.Close
Workbooks(mCalc).Close savechanges:=False
End If
Next cRng
End Sub
This line:
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
needs to be changed a little. You need to include the name of the workbook inside a single quotes, even if it looks like you are specifying the proper workbook with Workbooks(mCalc):
Workbooks(mCalc).Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
You can actually just shorten it to:
Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
If the macro you need to find relative macro path by using workbook path from which you run macro and you need to run several macros from the array list, the code below will help:
Dim relativePath As String, programFileName As String
Dim selectedProgramsFiles() As String, programsArrayLastIndex As Byte, I As Byte
For I = 0 To programsArrayLastIndex 'Loop through all selected programs
programFileName = selectedProgramsFiles(I)
relativePath = ThisWorkbook.Path & "\" & programFileName
Workbooks.Open Filename:=relativePath
Application.Run ("'" & relativePath & "'!ModuleName.Main")
Workbooks(programFileName).Activate
ActiveWorkbook.Close SaveChanges:=False
Next I 'For I = 0 To programsArrayLastIndex 'Loop through all selected program
Application.Run "PERSONAL.xlsb!ClearYellow", 0
ClearYellow is the name of the sub in Personal.xlsb that is being run.
The "0" is the first argument of this sub (would omit if no arguments, could add more arguments separated by commas)
Application does not seem to be needed
This could be used to run from some other workbook also; the workbook would have to be open; if the name of that workbook had a space in it, the name would have to be surrounded by ''
Call does not work cross workbooks; haven’t tested within same workbook or within same module
Following the instructions in this Stack Overflow question, I tried to run my macro with the following code:
Sub ay1()
Dim fileName, Pathname As String
Dim wb As Workbook
Pathname = "/Users/ayy/Downloads/Folder1/STATS1/"
fileName = Dir(Pathname & "*.csv")
Do While fileName <> ""
Set wb = Workbooks.Open(Pathname & fileName)
DoWork wb
wb.Close SaveChanges:=True
fileName = Dir()
Loop
End Sub
Sub DoWork(wb As Workbook)
With wb
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$191").AutoFilter Field:=3, Criteria1:="="
Range("C2:C190").Select
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$C$96").AutoFilter Field:=3
Range("E95").Select
ActiveWorkbook.Save
ActiveWindow.Close
End With
End Sub
I saved this in a "master workbook" that is macro-enabled in the same directory where all my .csv files are located. I clicked run macro and selected ay1.
This is not running on any of my files. I'm not getting any errors.
Using a With block: you need to tie your references to wb with a leading .
Sub DoWork(wb As Workbook)
With wb.Sheets(1)
.UsedRange.AutoFilter
.Range("$A$1:$C$191").AutoFilter Field:=3, Criteria1:="="
.Range("C2:C190").EntireRow.Delete
.Range("$A$1:$C$96").AutoFilter Field:=3
End With
wb.Save
wb.Close
End Sub
I have this Code in Macro that i use to save files in csv. Is it possible now that i save this file in .bat Format ?
This is the Code i use :
Public Sub Export_File_as_CSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("Export")
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False
wbkExport.SaveAs Filename:="C:\Users\" & Environ("Username") & "\Desktop\User_Tableau.csv", FileFormat:=xlCSV, Local:=True
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
Sheets("Export").Select
Range("A1").Select
End Sub
Otherwise i have to save it in Excel and then again to convert in .txt file and then in .bat file. I try to automate all this steps with macro and save it .bat file.
Your help is much appriciated !
Thank you
Just if someone Needs it in the future, i found the solution ! Apparently i was really close.
This is the changes i made and it worked.
Code :
Public Sub Export_File_as_BAT()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
'Call Artifficial_Groups
'Call filterout_for_export
'Call RemoveDuplicates
'Call Allocate_BEZ
Set shtToExport = ThisWorkbook.Worksheets("Export")
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False
wbkExport.SaveAs Filename:="C:\Users\" & Environ("Username") & "\Desktop\User_Tableau.bat", FileFormat:=xlTextPrinter, Local:=True
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
Sheets("Export").Select
Range("A1").Select
End Sub
I'm new to VBA and stuck on an issue. I'm trying to copy a table to a .csv file and I want the end result to contain the original .xlsm name & the table name and date/time. I've successfully pieced together code to export the table to .csv with the table name and date/time but I'm struggling to get the file mane in there. I get the following error "Method 'SaveAs' of object'_Workbook' failed"
Below is what I have, any help would be great!
Sub ExportTableBanquetEarnings()
Application.ScreenUpdating = False
Sheets("BanquetEarnings").Visible = True
Sheets("BanquetEarnings").Select
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet, wsNew As Worksheet
Dim wbNewName As String
Dim wbCurrent As String
wbCurrent = ThisWorkbook.FullName
Set wb = ThisWorkbook
Set ws = ActiveSheet
Set wbNew = Workbooks.Add
With wbNew
Set wsNew = wbNew.Sheets("Sheet1")
wbNewName = ws.ListObjects(1).Name
ws.ListObjects(1).Range.Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
.SaveAs Filename:="F:\admin\Report Databases\BanquetTipouts" & "\" &
wbCurrent & wbNewName & Format(Now, "yyyymmdd_hhmm") & ".csv", _
FileFormat:=xlCSVMSDOS, CreateBackup:=False
End With
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
ActiveWorkbook.RefreshAll
Sheets("BanquetEarnings").Visible = False
Sheets("Blank Cost Sheet").Select
Workbooks.Open "F:\Function Agreements\Cost Sheets M\Payroll Report -
V2.xlsm"
End Sub
The below code will show the path of that Workbook
wbCurrent = ThisWorkbook.FullName
I think what you meant to use is...
wbCurrent = ThisWorkbook.Name
Also, I think another issue might be the Now method, it should be as Now()
I have the following code to save my worksheets as csv files to the folder the workbook is saved in. How do I modify this to bring up a 'save as' dialog box to let me choose where I'd like to save?
To be more specific, I want to modify the code to be able to specify just the path to which all the files can be saved. I'm not looking to get a save as for each worksheet.
Sub SaveOnlyCSVsThatAreNeeded()
Dim ws As Worksheet, newWb As Workbook
Application.ScreenUpdating = False
For Each ws In Sheets(Array("01 - Currencies", ..."14 - User Defined Fields"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
End Sub
I have replaced the whole thing with a folder picker in an effort to simplify it. Posted updated code. Now I get Error code 9 - Subscript out of range.
Sub SaveOnlyCSVsThatAreNeeded()
Dim ws As Worksheet, newWb As Workbook
Dim pathh As Variant
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
FolderName = .SelectedItems(1)
End If
End With
pathh = FolderName
Application.ScreenUpdating = False
For Each ws In Sheets(Array("01 - Currencies", "02 - .....14 - User Defined Fields"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs pathh.path & "\" & ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
End Sub
Use the following code to show the Save As dialog screen:
pathh = Application.GetSaveAsFilename( _
FileFilter:="CSV Files (*.csv), *.csv", _
Title:="Save all spreadsheets", _
InitialFileName:=filenamestring)
Cheers
The command to propt the save as dialog in VB is:
Application.GetSaveAsFilename