I am having trouble with a macro I have created. I am creating multiple workbooks based on a selection made by the user. However, I want to remove the macro, and a worksheet from each file I have created. The code I have tried stops the code looping through the range as it seems maybe it is deleting the macro from the original file I am working from. Below is the code as it stands now which creates the workbooks as I want them fine but still with the worksheet containing a command button used to trigger the macro and the macro still in them. I need each file saved without them and the original template file to be unaffected.
Sub Button3_Click()
Dim MyCell As Range, MyRange As Range
Dim currentSheet As Excel.Worksheet
Dim LR As Long
Set currentSheet = ActiveSheet
LR = Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
For Each MyCell In MyRange
Worksheets("Front Sheet").Cells(5, 5) = MyCell.Value
ActiveWorkbook.RefreshAll
ActiveWorkbook.SaveAs Filename:="P:\Informatics\S&L scorecards\Clinical Scorecard Template\test\" & MyCell.Value & ".xls"
'here I want it to then delete the macro and a sheet called "Member"
Next MyCell
End Sub
Please note, I have tried the .xlsx file type but that also stops the loop - even if I use Application.DisplayAlerts = False
Related
I am setting up VBA code which does the following when run:
Runs a loop to open Excel files in a folder, one by one
Every time that an Excel file is opened, a password unprotects the worksheet and unmerges cells
Once the cells are unmerged, the data from the Excel file is copied and pasted to specific cells in the workbook where the VBA code is originally saved/stored
Upon pasting the data, the opened Excel workbook from the loop now closes (not necessary to save), and the next workbook is opened, where the next set of data is placed one row below the previous row
The VBA code is run from a workbook which always remains open, we can call it "Workbook 1.xlsm" In this instance for the code below, the use of wbPaste as the active workbook is intended to reference "Workbook 1.xlsm". Because the name of the workbook is going to change every month that this is run, I wanted to declare a workbook by using a naming convention that would reference the name, regardless of what the workbook is called.
The files that are in the folder can have various names, and could be in the hundreds of total files. I have declared most of the variables and have had success in getting the Excel workbooks to open from the folder. Unprotecting the sheet, and unmerging the cells has given some problems, however. I think that the issue that I am experiencing comes with looping the opening of the workbooks and which workbook is considered "active" at the time.
Sub OpenFilesForExtraction()
'declaration of variables
Dim myFolder As String
Dim myFile As String
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim lastRow As Long
'setting up name of folder and file type (any Excel file in folder) for the loop
myFolder = "C:\Users\Me\Desktop\Folder 1\"
myFile = Dir(myFolder & "*.xl??")
lastRow = 3
'start of loop
Do While myFile <> ""
Workbooks.Open fileName:=myFolder & myFile
'wbCopy is the Excel file that gets unprotected, unmerged and data is copied from. wbPaste will be where the data gets copied to. wbPaste is referencing the workbook where the macro is stored. By declaring these files in the loop, wbCopy should take on the name of the next file opening from the folder
Set wbCopy = Workbooks(myFile)
Set wbPaste = ActiveWorkbook
'Unprotecting and unmerging from the file wbCopy, that was opened by the loop statement
wbCopy.Unprotect Password:="Password1"
wbCopy.Unprotect
Range("C15:E15").Select
Selection.UnMerge
Range("H15:J15").Select
Selection.UnMerge
Range("C17:E17").Select
Selection.UnMerge
Range("B23:C23").Select
Selection.UnMerge
Range("B29:C29").Select
Selection.UnMerge
Range("B31:J37").Select
Selection.UnMerge
'Copying and pasting the information from the files that are being opened to the file wbPaste. Note that the range for where the value is pasted is determined by the value of "lastRow" variable, which is designed to paste information starting with the cells in row 3, then moving to row 4, row 5, and so on....
wbCopy.Range("C13").Value = wbPaste.Range("A" & lastRow).Value
wbCopy.Range("C15").Value = wbPaste.Range("B" & lastRow).Value
wbCopy.Range("H15").Value = wbPaste.Range("D" & lastRow).Value
wbCopy.Range("C17").Value = wbPaste.Range("I" & lastRow).Value
wbCopy.Range("J17").Value = wbPaste.Range("H" & lastRow).Value
wbCopy.Close
lastRow = lastRow + 1
myFile = Dir
Loop
End Sub
The program reaches a point where it will open up the first file from the folder, however, I get an immediate error after that. I think that there are two potential reasons.
First, I am not certain if I should use anything related to ActiveWorkbook. The reason why is because as I loop through opening the Excel documents in the folder, the VBA code may not understand which is meant to be the ActiveWorkbook at certain times.
Second, the Unmerging and copy/paste of values is where this will stop the program. I have had some chances to allow the cells to unmerge, but I think it came at the cost of calling out the wbCopy file as an ActiveWorkbook, when it really isn't meant to be called out as an active workbook.
There are a number of issues here
Relying on ActiveWorkbook when opening books changes what's active
Using Select
Your copy/paste is reversed
Unnecessary second Unprotect
Not using ThisWorkbook (you say you specifically want to paste into the book containing the VBA code)
Refering to Range's on Workbooks, instead of Worksheets
Your code, refactored
Sub OpenFilesForExtraction()
'declaration of variables
Dim myFolder As String
Dim myFile As String
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim lastRow As Long
'setting up name of folder and file type (any Excel file in folder) for the loop
myFolder = "C:\Users\Me\Desktop\Folder 1\"
myFile = Dir(myFolder & "*.xl??")
lastRow = 3
'start of loop
Set wsPaste = ThisWorkbook.Worksheets("NameOfSheetToPasteOn")
Do While myFile <> vbNullString
'wbCopy is the Excel file that gets unprotected, unmerged and data is copied from. wbPaste will be where the data gets copied to. wbPaste is referencing the workbook where the macro is stored. By declaring these files in the loop, wbCopy should take on the name of the next file opening from the folder
Set wbCopy = Workbooks.Open(Filename:=myFolder & myFile)
'Unprotecting and unmerging from the file wbCopy, that was opened by the loop statement
wbCopy.Unprotect Password:="Password1"
Set wsCopy = wbCopy.Worksheets("NameOfSheetToCopyFrom")
With wsCopy
'wbCopy.Unprotect
.Range("C15:E15").UnMerge
.Range("H15:J15").UnMerge
.Range("C17:E17").UnMerge
.Range("B23:C23").UnMerge
.Range("B29:C29").UnMerge
.Range("B31:J37").UnMerge
'Copying and pasting the information from the files that are being opened to the file wbPaste.
'Note that the range for where the value is pasted is determined by the value of "lastRow" variable,
'which is designed to paste information starting with the cells in row 3, then moving to row 4, row 5, and so on....
wsPaste.Range("A" & lastRow).Value = .Range("C13").Value
wsPaste.Range("B" & lastRow).Value = .Range("C15").Value
wsPaste.Range("D" & lastRow).Value = .Range("H15").Value
wsPaste.Range("I" & lastRow).Value = .Range("C17").Value
wsPaste.Range("H" & lastRow).Value = .Range("J17").Value
End With
wbCopy.Close False
lastRow = lastRow + 1
myFile = Dir
Loop
End Sub
I have created a macros on a worksheet that sets the cells within a dynamic range to "0". It works great. I want this code to be available for use on other worksheets so I added the working code to my PERSONAL.XLSB. When I copy that same code to PERSONAL.XLSB it does not work. Not even on the original worksheet that it had worked on because I moved the code to Personal.XLSB
I have other macros in Personal.xlsb that works so I know I'm utilizing my personal macros workbook correctly.
Sub Zero()
Dim lastRow As Long
Dim ws As Worksheet
Set ws = Sheet1
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
ws.Range("AA16:AA" & lastRow).FormulaR1C1 = "0"
End Sub
This code causes all of the Cells, starting at AA16 down to the last cell with content to be set to "0". Hooray! When this code is copied to Personal.xlsb, it does nothing.
I don't get an error message, just nothing happens.
The problem is at row #3 where you are setting the value of variable ws. If you put breakpoint on that line and use your debugger you'll see that the program does not recognize 'Sheet1' or at least not as you want it to (as a instance of Worksheet object) (see the image bellow).
The solution to this depends on what you need. You can simply replace 'Sheet1' with ActiveWorkbook.ActiveSheet, this way the macro will change the content in column AA for active worksheet. See the code below:
Sub Zero()
Dim lastRow As Long
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
ws.Range("AA16:AA" & lastRow).FormulaR1C1 = "0"
End Sub
I would like to copy a range of cells in a closed notebook that does not have a static set of rows. I would like to copy it into an active workbook.
I am trying to dynamically copy all entries under the column of F from file 'test.xlsx' from the 'exception' worksheet. The macro runs without issue if there I use static referencing instead. Here is the code that I am running, it gives me a runtime error for the line that copies the data.
Sub GetClassID()
Dim App As New Excel.Application
Dim wsActive As Worksheet
Set wsActive = ThisWorkbook.ActiveSheet
Dim wbImport As Workbook
Set wbImport = App.Workbooks.Open(Filename:="C:\Test.xlsx",
UpdateLinks:=True, ReadOnly:=True)
wbImport.Worksheets("Exception").Range("F2",Range("F2").end(xldown)).Copy
wsActive.Range("A2").PasteSpecial Paste:=xlPasteFormats
wsActive.Range("A2").PasteSpecial Paste:=xlPasteValues
App.CutCopyMode = False
wbImport.Close SaveChanges:=False
App.Quit
End Sub
Error I get is runtime erorr '1004': Interface not registered
Assuming you run this in an Excel VBA? You don't need to open the other workbook as an Excel.Application, just remove the app out of it and open the workbook normally:
Sub GetClassID()
Dim wsActive As Worksheet
Set wsActive = ThisWorkbook.Sheets("Another Sheet Name")
Dim wbImport As Workbook
Set wbImport = Workbooks.Open(Filename:="C:\Test.xlsx", UpdateLinks:=True, ReadOnly:=True)
With wbImport.Worksheets("Exception")
.Range("F2", .Range("F2").End(xlDown)).Copy
End With
wsActive.Range("A2").PasteSpecial Paste:=xlPasteFormats
wsActive.Range("A2").PasteSpecial Paste:=xlPasteValues
App.CutCopyMode = False
wbImport.Close SaveChanges:=False
App.Quit
End Sub
In my experience, the most effective way to copy a dynamic range is to create a variable as an integer and assign the row of the last cell to be copied (or column if needing to select a row of data across to a certain point. I usually accomplish it with something like this:
Dim R as Integer
With ThisWorkbook.Worksheets
R = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Then you can plug in 'R' for the row number in a range to make it dynamic each time the macro is ran. For instance: .Range("A1:A" & R).Copy would copy the used range in Column A. It also makes it really easy to reference the last row for loops and such continuously throughout your code. Hope this helps!
Ignoring what my code actually does (it's not important to my question):
I want to be able to open my excel file, press a button, have the code use data in that workbook and another opened workbook (so I would have two workbooks opened at the same time, the macro runs in one of them but can take data from both of them).
The trick here is that I can't seem to find code to access the other workbook that I've opened up, so I can only take info from the active workbook.
For example,
Private Function GetLastRow() As Integer
Dim myLastRow As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
myLastRow = Range("C" & Rows.count).End(xlUp).Row
GetLastRow = myLastRow
End Function
This code lets me access the active workbook (the one running the code), using ThisWorkbook.
Is there another function capable of allowing me to access another opened workbook?
You could change your function to be more flexible.
Private Function GetLastRow(InWorksheet As Worksheet, InColumn As Variant) As Long
GetLastRow = InWorksheet.Cells(InWorksheet.Rows.Count, InColumn).End(xlUp).Row
End Function
So you can call it …
Sub Test()
Dim LastRow As Long
LastRow = GetLastRow(ThisWorkbook.Worksheet("Sheet1"), "C") 'column as letter
'or
'LastRow = GetLastRow(ThisWorkbook.Worksheet("Sheet1"), 3) 'column as number
End Sub
So you can even run this on another workbook using:
LastRow = GetLastRow(Workbooks("OtherWorkbook.xlsx").Worksheet("Sheet1"), "C") 'column as letter
There is a Workbook object built into VBA that you can use. This documentation should give you the information that you need https://learn.microsoft.com/en-us/office/vba/api/excel.workbook
You would simply put the name of your other workbook in quotes, in parentheses after using the Workbook object (see example on page I hyperlinked). Good luck!
I guess this is what you looking for.
When you have more then one Workbook active you can switch between then.
Sub GetLastRow()
Dim myLastRow As Integer
'Active Workbook
Set ws = ThisWorkbook.Sheets("Plan1")
myLastRow = ws.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow
'Way when you know workbook name
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Teste1.xlsx"
Set ws1 = Application.Workbooks("Teste1.xlsx").Sheets("Plan1")
myLastRow1 = ws1.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow1
Dim myLastRow As Integer
'If you don't know the name but, opened after your main Workbook
Set ws3 = Application.Workbooks(2).Sheets("Plan1")
myLastRow3 = ws1.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow3
End Sub
I've got a workbook with two spreadsheets named "WT-1" and "CL-1" (it could be more of them with diff. names).
When i.e. "WT-1" is active, I would like to be able to (by using a button with macro assigned to it) copy this current (active) spreadsheet and rename it in sequence like WT-2, WT-3, WT-4 etc .
I guess change needs to apply only to spreadsheets who's name contains "WT-" as the name change should be addressed to the new sheet only. All other existing worksheets should not be touched. here it is - Pls help :) It changes name of one new spreadsheet. If there is more than just 1 worksheet in my workbook, it doesn't work.
Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left(Trim(ws.Name), 3) = "WT-" Then
ws.Name = shtName(i)
i = i + 1
End If
Next ws
End Sub
Macro is suppose just to change the name of a new and freshly copied spreadsheet. So if I copy WT-2 and create new sheet named WT-2(2) and run macro - it will work and change new sheet name to WT-1 (being first name in the range on 'wslist') . That seems to be OK. But, if I have any other spreadsheet in my workbook (except active sheet and already copied new sheet) it doesn't work and gives me an error 1004 - "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"
When I click on de-bag, this I found highlighted: ws.Name = shtName(i)
The issue is if you have the situation with following sheets
WT-1
WT-1 (2)
WT-2
Your code tries to rename WT-1 (2) into WT-2 but that already exists.
So a possibility was you would need to rename these to something else first like
WT-1
#WT-2
#WT-3
and then remove the # in another loop.
This way you prevent renaming into a name that already exists.
Option Explicit
Public Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 3) = "WT-" Then
'test if we run out of sheet names
If i > UBound(shtName) Then
MsgBox "Running out of sheet names … aborting"
Exit Sub
End If
ws.Name = "#" & shtName(i) 'add a # to all new sheet names
i = i + 1
End If
Next ws
'remove the # from the sheet nam
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 1) = "#" Then
ws.Name = Right$(ws.Name, Len(ws.Name) - 1)
End If
Next ws
End Sub
As QHarr pointed out it's probably a good idea to test if you are running out of sheet names.