I am writing a reporting system where the user fills out a form and a form button runs a macro to save the file with a name based on several fields including a timestamp.
All the data is is also on a second sheet but in one row for ease of copying to a master sheet.
I am trying to to extend the save macro to copy this row to the last line of a second workbook.
This was successful when the macro was run from a separate workbook but I can't for the life of me work out how to do it from within the file itself.
I've triple checked the paths themselves, I know they're right as the new files are being created, I've run msgbox in the code to check the filename and the variable are the same too.
timestampedfile = Worksheets("single_line").Range("b3")
totalpath = Path & timestampedfile & ".xlsm"
ActiveWorkbook.SaveCopyAs filename:=totalpath
master_wb = "s:\blah\blah\blah.xlsx"
master_sht = "Master_Database"
contact_wb = totalpath
contact_sht = "single_line"
Workbooks.Open (master_wb)
Workbooks.Open (contact_wb)
MsgBox (totalpath)
Workbooks(contact_wb).Worksheets(contact_sht).Range("A3:AQ3").Copy Worksheets(master_wb).Sheets(master_sht).Range("A" & Rows.Count).End(xlUp)(2)
'
Both the Workbooks open so I know the paths are right, can anyone help?
Solution by OP
Solved thanks to comment about workbook variables by BigBen:
Use workbook variables, instead of referencing the workbook by name: Dim masterWb as Workbook, then Set masterWb = Workbooks.Open("s:\blah\blah\blah.xlsx" ). Similarly for the contact workbook. You might consider using worksheet variables too, instead of using sheet names.
Code changed to:
Dim master_wb As Workbook
Dim contact_wb As Workbook
Dim master_sht As Worksheet
Dim contact_sht As Worksheet
Path = "S:\blah\" & Worksheets("report").Range("c8") & "\"
filename = Worksheets("back_end_formulas").Range("e10")
timestampedfile = Worksheets("single_line").Range("b3")
totalpath = Path & timestampedfile & ".xlsm"
ActiveWorkbook.SaveCopyAs filename:=totalpath
SetAttr totalpath, vbReadOnly
Set master_wb = Workbooks.Open("S:\blah\Master_Database2.xlsx")
Set master_sht = master_wb.Sheets("Master_Database")
Set contact_wb = Workbooks.Open(totalpath)
Set contact_sht = contact_wb.Sheets("single_line")
ThisWorkbook.Activate
contact_sht.Range("A3:AQ3").Copy master_sht.Range("A" & Rows.Count).End(xlUp)(2)
master_wb.Close SaveChanges:=True
contact_wb.Close SaveChanges:=False
ActiveWorkbook.Close SaveChanges:=False
Related
I am writing a macro that opens 2 workbooks and does some manipulation in one and copies it over to another and then it saves it as a .csv file. The first workbook is opened by defined string variables using the workbooks.open function and the other workbook is opened by the filepath and the filename being values set by the cell values in the worksheet. The goal is to go down the column where the names are stored and open those workbooks, do the manipulation, save as a .csv file, close and then go to the next name in the column list.
dim fpath, fname, path, wname, tempname, fpath2 as string
dim mainwkbk, trgwkbk, srcwkbk as workbook
dim main_ws as worksheet
dim main_lr, name_col as integer
dim q as long
set mainwkbk = workbooks("title1.xlsx")
set main_ws = mainwkbk.worksheets(1)
main_ws.activate
main_lr = main_ws.cells(rows.count,10).end(xlup).row
fpath = Range("I2")
for q = 2 to main_lr
tempname = "_template_name.csv")
fpath2 = "C:\temp\locaiton\"
workbooks.open(fpath2 & tempname)
set trgwkbk = workbooks(tempname)
fname = main_ws.cells(q,10).value
path = fpath & fname & ".xlsx"
workbooks.open(path)
set srcwkbk = workbooks(fname & ".xlsx")
2nd_macro (fname)
next q
The 2nd macro does the manipulation, which essentially copes over columns from the .xlsx file to the .csv file and it also runs a 3rd macro. The 2nd and 3rd macros work essentially, because they've been tested independent of the master macro. The macro stops after it opens the 1st workbook. I've looked at other macros I"ve written and I don't recall them stopping after running. I don't have those files anymore so I can't test those macros.
so I started from scratch and this is the code I used. it's no different than the first comment.
dpath = Range("I2")
fname = Range("J2")
set srcwkbk = workbooks.open(dpath & fname)
tempname = "name.csv"
fpath = "C:\path\"
set trgwkbk = workbooks.open(fpath & tempname)
srcwkbk.activate
call ind_level_calc
transfer_macro (fname)
Background Information - I have two buttons, that both run a set of code. The excel file has over 30 columns and 65,000 rows. This file is exported (.csv) from somewhere and is updated biweekly.
Goal - have the new file saved with the same name as the old. So that the values can be updated, buttons are still available and the code can run again with the new file.
Or That when a new file is exported, it is saved in a folder that runs the code INDEPENDENT of the user path. i.e Pathname = ActiveWorkbook.Path & "C:\Users\"this can be any name"\Desktop\Downloads\"
Attempt
Used a similar code to the one in a previous question "Run same excel macro on multiple excel files" with edits to tailor for my code. With no success
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
Currently, when I attempt the first method I only replace (Old file + VBA) with (New file).
Please note that the solution does not need to be a VBA code. If it's just saving the file in a new method that stores the macro and updates the values I would be happy.
An example of my previous answer:
Sub SaveThisAs()
Dim wb As Workbook: Set wb = ThisWorkbook 'ThisWorkbook referrs to the workbook the macro is ran from
Dim PathToSaveTo As String
PathToSaveTo = wb.Path & "\"
PathToSaveTo = PathToSaveTo & Format(Now, "ddMMyyyy_hhmmss") & wb.Name 'Lets add a timestamp
'Do your macro stuff here
'....
'Save the workbook
wb.SaveAs PathToSaveTo
End Sub
Please note that I'm using wb.Name at the end of the file to save to... this will be fine first time you run this, but a second time the name will get longer... and longer ... and longer. Adjust as per your needs with an appropriate file name.
Below is working code that is looping through files in a folder based on a user's search criteria. The folder will grow throughout the year to over 1000 files, so rather than looping through all of them every time the macro runs, I would like to add a second criteria that compares the time stamps on the files to a time stamp saved on the file as the last time it was run. LastUpdateDate is set up as variable in date format at the top of the module, and the old timestamp is saved to it at the beginning of the code.
I tried this but it left me with a run time error. Is this doable using Do While, or is there another format I need to be looking at? I also tried nesting the date comparison as an if statement under the Do While, but came up with other errors.
Do While FileName <> "" and FileDateTime(FileName) > LastUpdateDate
Working code from this section:
FileName = Dir(FolderName & "*" & MyCriterion & "*" & ".xl??")
'Loop through all matching files
Do While FileName <> ""
'Open the next matching workbook
Workbooks.Open (FolderName & FileName)
Sheets("Report Data").Select
'Call GrabTheData
GrabTheData
'Close the workbook
Workbooks(FileName).Close savechanges:=False
'Get the name of the next match in folder
FileName = Dir
Loop
End Sub
Two things:
FileDateTime
FileDateTime requires the full file path, not just the file name
Loops and Conditions
Do While (condition) stops execution of the block when (condition) is no longer true.
That is, it will stop execution as soon as (condition) is false. I don't believe this is the intended behavior.
Put an If (condition) block within the loop itself. This will loop through every workbook that matches MyCriterion, but only operate on those that match (condition).
Example (with recommendations)
Sub GrabAllData(ByVal FolderName As String, ByVal MyCriterion As String)
Dim FileName As String
Dim LastUpdateDate As Date
Dim wb As Workbook
LastUpdateDate = ThisWorkbook.Worksheets("Parameters").Range("LastUpdateDate").Value 'Named Range called LastUpdateDate on sheet "Parameters" in ThisWorkbook
'Make sure FolderName ends in a backslash
If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"
'Get matching files for MyCriterion
FileName = Dir(FolderName & "*" & MyCriterion & "*" & ".xl??")
'Loop through all matching files
Do While FileName <> ""
If FileDateTime(FolderName & FileName) > LastUpdateDate Then 'FileDateTime requires the full file path, not just the file name
'Open the next matching workbook - work with the workbook directly, rather than working with ActiveWorkbook, ActiveSheet and Selections
Set wb = Workbooks.Open(FileName:=FolderName & FileName, ReadOnly:=True)
'Call GrabTheData on the workbook
GrabTheData wb
'Close the workbook
wb.Close SaveChanges:=False
End If
'Get the name of the next match in folder
FileName = Dir
Loop
Set wb = Nothing
End Sub
Sub GrabTheData(ByRef wb As Workbook)
Dim wsOut As Worksheet, wsIn As Worksheet
Set wsOut = ThisWorkbook.Worksheets("Aggregated Data") 'Worksheet called "Aggregated Data" in ThisWorkbook
Set wsIn = wb.Worksheets("Report Data")
' ### Manipulate the data and write to wsOut, no need to work with Selections ###
End Sub
I am trying to delete the contents of few cell in the saved copies of my workbook that is under different file names. As code below, this is deleting the content from original workbook and retaining the content in the saved wb. It is doing the right opposite task that I wanted for!
Also, any suggestion on how to disable few modules and delete few pictures in the saved wb ?
Thanks in Advance for help !
Sub SaveAsNewCopy()
Dim Path As String
Dim FileName1 As String
Application.DisplayAlerts = False
FileName1 = Range("D3")
ThisWorkbook.SaveCopyAs FileName:="C:\Users\..\..\..\" & FileName1 & "-" & "List" & ".xlsm"
MsgBox "File Saved successfully!", , "Save"
ThisWorkbook.Sheets("Sheet1").Range("E5:F5").ClearContents
ThisWorkbook.Sheets("Sheet1").Range("E9:F9").ClearContents
Application.DisplayAlerts = True
End Sub
You need to get a handle on the workbook you just saved, make the changes you want and then save it again. The easiest way to do this is to assign a variable to it. In your declarations do something like this:
Dim wb as Workbook
then before your save-as line assign the saved workbook to that variable like this:
Set wb = ThisWorkbook.SaveCopyAs FileName:="C:\Users......\" & FileName1 & "-" & "List" & ".xlsm"
Then you can work with wb as required as save it with wb.Save True etc etc
I have this little VBA module that I call from one workbook to update all Excel Workbooks in a given folder. By update I mean it copies a module called GetActiveXControlValues and then runs this macro on each workbook in that folder. Now when I run this on my machine everything works fine. When my co-worker runs this same code with the same files, they gets a surprise after copying the module. When you go to look at the workbook that should have the new module called 'GetActiveXControlValues', instead there is no module by that name, instead it is called 'Module1'. In addition, when you look inside the new module it says 'Attachment has been removed' in red. I checked and my co-worker has the exact same Security Settings in Excel 2010 as I have.
I have enable all Macros and Trust VBA Project Object Model. I have Prompt me for enabling all ActiveX controls. I have Disable Trusted Documents unchecked and all the boxes on the Protected View tab. Anyone seen this before or have an idea what I can try to troubleshoot?
Sample Code:
Sub CopyModuleAndExecuteIt()
Dim wb As Workbook
Dim sFile As String
Dim sPath As String
Dim sFullMacroName As String
SetFolder
sPath = sExcelFolder
ChDir sPath
sFile = Dir("*.xls") ' File Naming Convention
Do While sFile <> "" ' Start of LOOP
' Open each Excel File in the specified folder
Set wb = Workbooks.Open(sPath & "\" & sFile) ' SET BP HERE!
Sleep (1000)
' Unprotect the Documents using SendKeys Hack
UnprotectVBADocument
' Import the GetActiveXControlValues Module into the Workbook
wb.VBProject.VBComponents.Import ("D:\GetActiveXControlValues.bas") ' SET BP HERE!
sFullMacroName = "'" & wb.Name & "'" & "!" & wb.VBProject.VBComponents.Item("GetActiveXControlValues").Name & ".GetActiveXControlValues"
' Run the GetActiveXControlValues Macro
Application.Run (sFullMacroName)
' Close the Workbook Saving Changes
wb.Close True
sFile = Dir
Loop ' End of LOOP
End Sub
If your co-worker has the exact same Security Settings in Excel 2010 as you have then the next thing that comes to my mind is the "Firewall". Check his firewall settings.
I was working to create an AddIn trough VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Attribute VB_Name = "Module_Name"
And you have to be sure that you .bas file is actualy is plain text.
I was working to create an AddIn with VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Sub Superheroes()
Dim sBeg as string, sEnd as String, sCatwoman as String, sAntMan as String
Dim vCode As Variant
'' Here is where i put the name i want to call my module
sBeg = "Attribute VB_Name = ""VBA_BasFile""" + vbCrLf + _
"Private Function fMix(sAnimal as String)as String "
sCatwoman = "Select case sAnimal"+ vbCrLf+ vbTab+"case ""cat"""+ _
vbCrLf+ vbTab+ "fMix = ""Catwoman"""
sAntMan = vbCrLf+ vbTab+"case ""Ant"""+ vbCrLf+ vbTab+ "fMix = ""AntMan"""+ _
vbCrLf+ "End Select"
sEnd = vbCrLf+ "End Sub"
vCode = Array(sBeg, sCatwoman, sAntMan, sEnd)
Workbooks.add
Range("A1").Resize(UBound(vCode) + 1, 1) = Application.Transpose(vCode)
With ActiveWorkbook
.SaveAs path + "VBA_BasFile.bas", xlTextPrinter
.Close False
End With
End Sub
With this i can Call any procedure or function in the VBA_BasFile when i importe to another Excel Workbook.