I'm trying to write a vba code to save a specific worksheet as another workbook file. I want the user to be able to name the workbook file and path.
I tried different approaches but none of them worked.
If that's not possible, I'm ok with only saving to this location:
"Q:\Sorular\"
Spesific filename is shown in codes.
Sub Soru_Publish()
Dim fName1 As String
fName1 = Worksheets("Storyboard").Range("E3").Value & "_" & Worksheets("Storyboard").Range("E2").Value
Worksheets("Soru_Publish").Visible = True
Worksheets("Soru_Publish_2").Visible = True
Worksheets("Soru_Publish").Activate
Dim FirstBlankCell As Long, rngFound As Range
With Sheets("Soru_Publish")
Set rngFound = .Columns("A:A").Find("*", After:=.Range("A1"), _
searchdirection:=xlPrevious, LookIn:=xlValues)
If Not rngFound Is Nothing Then FirstBlankCell = rngFound.Row
End With
Worksheets("Soru_Publish").Range("A1:Y" & FirstBlankCell & "").Copy
Worksheets("Soru_Publish_2").Range("A1:Y" & FirstBlankCell & "").PasteSpecial Paste:=xlPasteValues
Worksheets("Soru_Publish_2").Copy
With ActiveWorkbook
.SaveAs filename:="Q:\Sorular\" & filename
.Close
End With
Worksheets("Sorular").Activate
Worksheets("Sorular").Range("B4").Select
Worksheets("Soru_Publish").Visible = False
Worksheets("Soru_Publish_2").Visible = False
End Sub
Unfortunately when I run the macro, I get Run-time error '1004' at SaveAs line.
Your code works, but using ActiveWorkbook can give you unexpected results.
If you want to save a single sheet as a new .xls file, just use .SaveAs directly on the sheet you need to save, like this:
Dim wrkSheet As Worksheet
Set wrkSheet = Worksheets("Soru_Publish_2")
wrkSheet.SaveAs Filename:="Q:\Sorular\" & fName1
Or like this if you don't want to define a new variable:
Worksheets("Soru_Publish_2").SaveAs Filename:="Q:\Sorular\" & fName1
Hope this helps.
Sorry, I forgot to change the " filename " to " fName1".
Code works just fine, it was just a typo.
Related
I would like to save file in a "CONSOLIDATE FOLDER". But the file path should depend on staff working number ID (00639) where they input it in the "TEMPLATE" worksheet cell "N3". And in case staff forgot to input their working ID, there'll be a pop up box telling them to fill in their ID.
Any help really appreciated.
Sub MergeFile ()
Dim WB As Workbook
Dim WS as Worksheet
Dim FileName as String
Dim FilePath as String
Set WB = Workbook.Add
FilePath = "C:\Users\KGA00639\Desktop\CONSOLIDATE FOLDER"
FileName = ThisWorkbook.Worksheets("TEMPLATE").Range("L15").Value
For Each WS in ThisWorkbook.Worksheets
If WS.Name <> "TEMPLATE" Then
WS.Copy before:=WB.Sheets(1)
End if
If FileName = "" Then
FileName = InputBox ("You did not name the workbook" & vbCrLf & _
"Please write the name and press OK.:,"Setting the workbook name")
If FileName = "" Then Exit sub
ThisWorkbook.Worksheets("TEMPLATE").Range("L15").Value = FileName
End If
Next
ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName
MsgBox ("Done"!)
ActiveWorkbook.Close
End Sub
This solution should come rather close to what you want. Please take a look.
Sub MergeFile()
' 056
Dim Wb As Workbook
Dim Ws As Worksheet
Dim FileName As String
Dim FilePath As String
Dim UserID As String
With ThisWorkbook.Worksheets("TEMPLATE")
UserID = .Cells(1, "A").Value ' change address to suit
FileName = .Range("L15").Value
If Left(UserID, 2) <> "ID" Then
MsgBox "You must enter your valid user ID in" & vbCr & _
"cell A1 of the 'Template' tab." & vbCr & _
"This program will now be terminated.", _
vbInformation, "Incomplete preparation"
.Activate
.Cells(1, "A").Select ' change to match above
Exit Sub
End If
End With
Application.ScreenUpdating = False
' use the UserID variable in whichever way you wish
FilePath = Environ("UserProfile") & "\" & UserID & "\Desktop\CONSOLIDATE FOLDER"
Set Wb = Workbooks.Add
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "TEMPLATE" Then
Ws.Copy Before:=Wb.Sheets(1)
End If
Next Ws
Wb.SaveAs FilePath & FileName, xlOpenXMLWorkbook
Application.ScreenUpdating = True
End Sub
You didn't specify where on the 'Template' tab the user ID would be found. The above code looks for it in cell A1. That cell is mentioned in 3 locations in the code (once in the message text). Please modify the code to match your facts.
You also didn't say where the UserID should appear in the FilePath. I placed it before the Desktop. I'm sure you will know how to amend that bit of code to suit you better.
When saving the workbook my code specifies an xlsx format. If this isn't what you want change the file format constant in the SaveAs line. I didn't think it a good idea to specify the extension in the 'Template'. You may like to move it to the code.
Finally, you didn't specify the next step after creation of the new workbook. So the code ends in the middle of nowhere. Excel made the new workbook the active one but you may like to close it, or ThisWorkbook, and determine what to do with the blank worksheet(s) still contained in the new book. There are a lot of lose ends still to tidy up. Good luck!
I'm writing a code to delete a log entry in a .csv file. The code starts with opening the .csv file, using Application.Match to return the row number, and then deleting that and closing the file again. The problems I'm experiencing are I get a type mismatch (my error handling is activated) OR (and here it gets weird) it works (a match is found, the row is deleted) but then the logfile is messed up - all data is one string in column a with either ";" or "," delimiters (this varies somehow, relevant note: I use Dutch language excel). Of course, this makes it impossible for the macro to find a match in any case.
I found that the type mismatch problems I'm experiencing will most likely be caused by the code not finding a match, and this is what I don't understand since I checked and doublechecked the input and the data in the logfile - by all means it simply should find a match. And sometimes it does find a match, deletes the row and messes up formatting. (NOTE: Mostly it does NOT find a match.)
I check data in the .csv file before running the macro. I have tried running the macro with the .csv file already opened. I have tried to Set the matchArray from outside the With. I have tried both sweet talking my laptop and a more aggressive approach, to no avail.
Sub DeleteRowFromFile(ByVal matchValue As String)
Dim filePath As String
Dim fileName As String
Dim fileType As String
Dim matchArray As Range
Dim rowToDelete As Variant
'Naming variables for flexibility
filePath = "C:\Users\Maxim\Documents\Log\"
fileName = "TestRegister"
fileType = ".csv"
Application.ScreenUpdating = False
Workbooks.Open (filePath & fileName & fileType)
With Workbooks(fileName).Worksheets(1)
Set matchArray = .Range("A:A") 'set range in the logfile
'Type mismatch here:
rowToDelete = Application.Match(matchValue, matchArray, 0)
If Not IsError(rowToDelete) Then
Rows(rowToDelete).Delete
Else:
MsgBox "Orderno. " & matchValue & " not found.", vbOKOnly + vbExclamation, "Error"
End If
End With
'Closing the log file
Workbooks(fileName).Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Sub MatchAndDelete()
Dim matchValueRange As String
matchValueRange = ActiveWorkbook.Worksheets(1).Range("A1").Value
DeleteRowFromFile (matchValueRange)
End Sub
Footnote:
I'm a struggling enthusiast, I have a lot to learn. Sorry in advance if I have left out any crucial information for you to be of help, and thanks a lot for any and all help.
When you open or save a csv file using a VBA macro Excel will always use the standard (US English delimiters) while if you do the same via the user interface it will use the separators as defined in the Windows regional settings, which probably is ";" in your case.
You can check with .?application.International(xlListSeparator) in the immediate window of your VBEditor.
You can tell Excel to use a different separator, by e.g. adding sep=; as line 1 of your file. Hoever this entry is gone after opening the file. The following code - added before you open the csv file will add this:
Dim oFSo As Object
Dim oTxtFile As Object
Dim strData As String
Set oFSo = CreateObject("Scripting.FileSystemObject")
strData = oFSo.OpenTextFile(filePath & fileName & fileType, 1).ReadAll
Set oTxtFile = oFSo.OpenTextFile(filePath & fileName & fileType, 2)
oTxtFile.writeline "sep=;"
oTxtFile.writeline strData
oTxtFile.Close
You can save your changed file by using the Excel UserInterface Shortcuts via the Application.SendKeys thus achieving what you want:
Application.SendKeys ("^s") 'Save
Application.SendKeys ("^{F4}") 'Close
Dont run this code from the VBE Immeditate window as it will probabaly act on the wrong file!
The full code - just with an alternate way to make the requested change:
Sub DeleteRowFromFile(ByVal matchValue As String)
Dim filePath As String
Dim fileName As String
Dim fileType As String
Dim matchArray As Range
Dim rowToDelete As Variant
Dim oFSo As Object
Dim oTxtFile As Object
Dim strData As String
Dim content As Variant
Dim i As Long
'Naming variables for flexibility
filePath = "C:\Users\Maxim\Documents\Log\"
fileName = "TestRegister"
fileType = ".csv"
Application.ScreenUpdating = False
'Adding "sep =" ; as line 1 of the log file
Set oFSo = CreateObject("Scripting.FileSystemObject")
strData = oFSo.OpenTextFile(filePath & fileName & fileType, 1).ReadAll
Set oTxtFile = oFSo.OpenTextFile(filePath & fileName & fileType, 2)
oTxtFile.writeline "sep=;"
oTxtFile.writeline strData
oTxtFile.Close
'Open logfile
Workbooks.Open (filePath & fileName & fileType)
'Make your changes
With Workbooks(fileName).Worksheets(1)
content = .UsedRange.Value
For i = UBound(content, 1) To 1 Step -1
If content(i, 1) = matchValue Then
.Rows(i).Delete
End If
Next i
End With
'Closing the log file via Sendkeys using excel shortcuts
Application.SendKeys ("^s") 'Save
Application.SendKeys ("^{F4}") 'Close
Application.ScreenUpdating = True
I think that Match it is not required. Try this one.
Sub DeleteRowFromFile(ByVal matchValue As String)
Dim filePath As String
Dim fileName As String
Dim fileType As String
Dim matchArray As Range
Dim rowToDelete As Variant
'Naming variables for flexibility
filePath = "C:\Users\Maxim\Documents\Log\"
fileName = "TestRegister"
fileType = ".csv"
Application.ScreenUpdating = False
Workbooks.Open (filePath & fileName & fileType)
With Workbooks(fileName).Worksheets(1)
For i = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If .Cells(i, 1).Value2 = matchValue Then
.Cells(i, 1).EntireRow.Delete
End If
Next
End With
'Closing the log file
Workbooks(fileName & fileType).SaveAs Filename:= _
(filePath & fileName & fileType) _
, FileFormat:=xlCSVMSDOS, CreateBackup:=False 'Saving the file
Workbooks(fileName & fileType).Close 'Closing the file
Application.ScreenUpdating = True
End Sub
Hope it helps
So I have a currently working VBA script. I just want to edit the name by which the loop saves files.
I'll give a quick description of what it is currently doing. Basically it loops a set of actions for a defined range of rows, here A2:A72. The is a 'main' workbook where this loop is done is where all the input data is collected. Each row is a separate subject's input data and is copy/pasted into a template in a different workbook. Solver is then run to adjust the template for the given input data. Then it saves and names file as the text in the first cell of the row that was copy pasted. (ie A2,A3,A4,etc..) It then loops this for every row and every row will have its own template set up and saved separately.
This is ALMOST how I ideally want it to work.
I just want it save the File name not just as A2, but as =C2&" - "&A2
I tried using this that was suggested by someone
fName = Range("C" & c.Row) & Range("A" & c.Row)
But when I tried I would get a Method SaveAs error. On the watch view I could see it was because it wasn't reading the fName so it was just the file path in the script value. I changed it back to c.Value and then it started working by naming the file as the A column cell. Admittedly, I don't really understand how c.Value is returning column A which makes it harder for me to figure out how to modify it to get what I want.
Anyway here is the script as I currently have it:
Sub RunModels()
Dim fPath As String
Dim strTemplate As String
Dim fName As String
Dim wb As Workbook
Dim c As Range
Dim rngLoop As Range
'Where will files get stored?
fPath = "H:\ACQUISITIONS\Personal (D-AP)\Gmo\ALL MF"
'Where is the template file?
strTemplate = "H:\ACQUISITIONS\Personal (D-AP)\Gmo\ALL MF\Garden Grove - 11121 Chapman Ave.xlsm"
'Error check
If Right(fPath, 1) <Application.PathSeparator Then
fPath = fPath & Application.PathSeparator
End If
Application.ScreenUpdating = False
'Set Loop
Set rngLoop = ThisWorkbook.Worksheets("Sheet1").Range("A2:A72")
'Set Looped Actions
For Each c In rngLoop.Cells
'Open the template file
Set wb = Workbooks.Open(strTemplate)
'Add some data to the template file
c.EntireRow.Copy Destination:=wb.Worksheets("Insert
Sheet").Range("A2")
SolverOk SetCell:="$H$20", MaxMinVal:=3, ValueOf:=1.2, ByChange:="$F$35", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
'Dynamic File Naming
fName = c.Value
'Save the file and close
wb.SaveAs Filename:=wb.Path & Application.PathSeparator & fName
wb.Close
Next c
Application.ScreenUpdating = True
End Sub
Thank you very very much for all and any help!!
You should not use wb.Path wb is assigned to the workbook, where fPath is your folder path, so use:
Filename:=fPath & "\" & fName & ".xlsx"
or ".xlsm" as required.
To assign fName use:
fName = c.Offset(, 2).Value & " - " & c.Value
The code assigns the variable c to each cell in the range A2:A72 in turn - so at the moment it is saving the code 71 times. The code
fName = Range("C" & c.Row) & Range("A" & c.Row)
would produce c2 & A2 on the first time through, and then C3 & A3 on the second (and so on. I suspect you'd like it to always use c2 and then add the value in A - in which case you'd need
Fname = Range("C2") & "- " & c
I am trying to write a code that I copied from somewhere else.
The code is not working and gives me an error.
Can someone please review and advise if there is a syntax error
Dim directory As String, filename As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String
Application.DisplayAlerts = False
directory = "U:\GMR & PAYROLL REPORTS 2018-19\FEBRUARY 2019\COMPLETED\PAYSLIPS\"
filename = Dir(directory & "*.csv")
Do While filename <> " "
Workbooks.Open (directory & filename)
WrdArray() = Split(filename, ".")
For Each sheet In Workbooks(filename).Worksheets
Wookbooks(filename).ActiveSheet.Name = WrdArray(0)
total = Workbooks("PAYSLIPS CONSOL.xlsm").Worksheets.Count
Workbooks(filename).Worksheets(sheet.Name).Copy after:=Workbooks("PAYSLIPS CONSOL.xlxm").Worksheets(total)
GoTo exitFor:
Next sheet
exitFor:
Workbooks(filename).Close
filename = Dir()
Loop
Sheets("ALL HOMES").Select
lastsheets = Worksheets.Count
For i = 2 To lastsheets
mysheet = Sheets(i).Activate
mysheetrow = Cells(Rows.Count, 1).End(x1Up).Row
Range("A1;U" & mysheetrow).Select
Selection.Copy
Sheets("ALL HOMES").Select
lastrow = Cells(Rows.Count, 1).End(x1Up).Row
Range("A1").Select
Range("A" & lastrow).Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Next i
MsgBox "Your Report is Ready"
Application.DisplayAlerts = True
End Sub
In general, you can use VBA compiler to check whether your project can compile. To do this in the VBA Editor, click Debug -> Compile VBA Project. Everytime you click it, it will either run smoothly and say nothing, or show you the first compilation error in the project it runs into (so you can fix it and click Compile again).
I tried to compile the code you posted:
First, as suggested in the comment, you don't have the Sub line at the top. For example
Sub create_payroll()
, where create_payroll is your preferred name for this macro. Put this line right above all the code you posted in the question.
Second, there is a typo "Wookbooks" instead of Workbooks.
I've got a need to open some Excel files and "pause" then close them. In this process I run one macro on opening, and another on closing. The opening one works fine because it is done as each file is opened. But the closing part of the code I can't get it to run the correct macro. They have the same names, but the file contests are different, and what the macro does per file is different.
This is the gist of what I'm doing now
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
path = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
filename2018P1 = "2018 P1.xlsm"
Set xlbook2018P1 = xlApp.WorkBooks.Open(path & filename2018P1)
' Run Macro
xlApp.Run "AutoRefresh"
filename2018P3 = "P3 2018 HRR.xlsm"
Set xlbook2018P3 = xlApp.WorkBooks.Open(path & filename2018P3)
'Run Macro
xlApp.Run "AutoRefresh"
'My "pause"
WScript.Echo ("All Files were" & Chr(013) & _
"opened and refreshed, update ppt before OK" & Chr(013) & _
" DO NOT CLICK OK" & Chr(013))
'==========================
'Below is the trouble spot.
'==========================
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
The first part works fine, but trying to run the file's respective AutoPublish macro does not. The code works fine if I leave out that Run line. (The real file names have spaces and I had to add the single quotes to get it to accept the filename.)
What it appears to be doing is using the macros from the last file opened, not the one it's directed to use it the run line. I think I need a way to "select" the correct file, or give it focus so the macro could run without an explicit filename argument, which it appears to be ignoring anyway.
EDIT:
Solution was:
xlbook2018P1.Activate ' This fixed it, I think
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlbook2018P3.Activate
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
When tackling similar tasks, I usually work around by implementing a master Excel file first, and call a sub in this master file via VBS. The advantage to me seems it is way easier to fullfill all tasks in the VBA of the master file rather than having to code all that in VBS.
Create a master file, e.g. "Master.xlsm", list all your files you need to open on a sheet named "Files" in column A, starting in row 1.
Insert a module and place the following sub in this module:
Sub Main()
Dim strPath As String
Dim strFile As String
Dim lRow As Long
Dim i As Long
Dim k As Integer
Dim n As Long
Dim wb(1 To 3) As Workbook
Dim wbTest As Workbook
Set wbMaster = ThisWorkbook
strPath = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
'Check how many files you need to open
With Sheets("Files")
lRow = Sheets("Files").Range("A" & .Rows.Count).End(xlUp).Row
End With
'open all available files
For i = 1 To lRow
Workbooks.Open (wbMaster.Sheets("Files").Range("A" & i).Value)
Next
'now run the two macros in each open file
For k = 2 To Workbooks.Count 'this will work only if your master file is the only one open when starting the sub!
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoRefresh"
DoEvents
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoPublish"
DoEvents
Next
'and close all files previously opened except for the master file
For n = Workbooks.Count To 2 Step -1
Workbooks(n).Close False
Next
End Sub
It seems like a possible explanation for what you're seeing is that your AutoPublish macro refers to ActiveWorkbook and not the safer ThisWorkbook. If another workbook is active when it's called that could lead to unexpected results.