I have a CommandButton which opens a UserForm and create a copied Sheet with the name of the ComboBox Value.
This is My Code:
Private Sub CommandButton1_Click()
[UserForm1].Show ' Open UserForm
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
ActiveWorkbook.Sheets("Sheet1").Visible = True ' Unhide Sheet
Sheets("Sheet1").Copy _
Before:=ActiveWorkbook.Sheets("Sheet1") ' Copy Sheet
Set ws = ActiveSheet
ws.Name = ComboBox1.Value ' Name Sheet
[UserForm1].Hide ' Close UserForm
ActiveWorkbook.Sheets("Sheet1").Visible = False ' Hide Sheet again
End sub
Now my problem is, if there are two machines with name "Machine Type 1" Excel gets an Error. So what do i have to change in my code, that the second sheet would named e.g. "Machine Type 1 (2)?
Thanks for your help.
you could try this
Private Sub CommandButton1_Click()
If IsSheetThere(ComboBox1.Value) Then 'if some sheet with chosen name already there
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
With ActiveSheet 'reference just copied sheet
.UsedRange.Clear 'clear its content
Sheets("Sheet1").UsedRange.Copy ActiveSheet.Range("A1") ' copy Sheet1 content and paste into it
End With
Else 'otherwise
Sheets("Sheet1").Copy Before:=Sheets(Sheets.Count) ' make a copy of "Sheet1" sheet
ActiveSheet.Name = ComboBox1.Value 'and rename it as per chosen name
End If
Me.Hide
End Sub
Function IsSheetThere(shtName As String) As Boolean
On Error Resume Next
IsSheetThere = Not Sheets(shtName) Is Nothing
End Function
the code line:
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
is the one that leaves Excel the burden of somehow "counting" the number of already existing sheets with the chosen name, and name the new one appropriately
You can use the following sub which calls the below function, just apply the same logic using .Copy
Sub create_new_sheet_with_name(name As String, wb As Workbook, aftersheet As Variant)
Dim i As Integer
i = 2
If sheet_name_exists(name, wb) Then
Do While sheet_name_exists(name & " (" & i & ")", wb)
i = i + 1
Loop
wb.Sheets.Add(after:=aftersheet).name = name & " (" & i & ")"
Else
wb.Sheets.Add(after:=aftersheet).name = name
End If
End Sub
Function sheet_name_exists(name As String, wb As Workbook) As Boolean
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheet_name_exists = True
Exit Function
End If
Next sheet
sheet_name_exists = False
End Function
here's an example of how to use the sub:
Sub test()
create_new_sheet_with_name "hi", ThisWorkbook, ThisWorkbook.Sheets(1)
'this adds a new sheet named "hi" to thisworkbook after thisworkbook.sheets(1)
End Sub
Technically this isn't an answer to this question... but it's better because it will help you solve this and many other coding tasks on your own.
There is a simple way to create VBA code for most basic tasks.
If there's something Excel can do that you want to be able to do programmatically, just Record a Macro of yourself performing the action(s), and then look at the code that Excel generated.
I have a terrible memory, I can't remember commands I used yesterday. So it's not only quicker and less frustrating for others for me to figure it out myself, but the more often I do that, the quicker I'll learn (without asking others to do the thinking for me on a basic question).
I fact, I'm guess that the majority of veteran VBA coders learned at least partly by analyzing recorded macros. I know I did.
Related
So I am trying to write a Macro for Excel, that adds 2 worksheets from an excel file to a new one.
Therefore, I try this:
Sub addfile()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page1.xltx")
Set sheet2 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page2.xltx")
End Sub
When I test it, it imports the first page, but the 2nd page gives me a Runtime error 1004.
Why does this happen?
And is there another way to get 2 sheets from one excel file to another via vba?
Much to my surprise this version of your code actually worked for me.
Sub addfile()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Template1.xltx")
Set Sheet2 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Book2.xlsx")
Debug.Print Sheet1.Name, Sheet2.Name
End Sub
The reason for my surprise is that Sheet1 and Sheet2 are the default CodeName for the first and second worksheets in any workbook. Therefore there is a conflict of naming between the Sheet1 in the workbook and the Sheet1 you declare which should come to the surface not later than Debug.Print Sheet1.Name. In fact, it may have. I didn't check which name was printed. But the code didn't crash. Since it crashes on your computer, perhaps you have an older version of Excel. Try to stay clear of variable names that Excel also uses. Or there is something wrong with the path & file name, which is hard to tell in that syntax and therefore kept me fooled for quite some time too.
In fact, I discovered the above only after finding out that my Desktop was on OneDrive and not before I had written the function below which is designed to avoid the use of Sheets.Add. It also has some extras such as being able to specify the sheet to take from the template (you could have one template with 2 or more sheets). You can specify an index number or a sheet name. And the function will give a name to the copy, too, if you specify one.
Private Function AddWorksheet(ByVal Template As String, _
TabId As Variant, _
Optional ByVal TabName As String) As Worksheet
Dim Wb As Workbook
Dim Path As String
Dim FileName As String
Set Wb = ThisWorkbook ' change to suit
' make sure the path ends on "\"
Path = "C:\Users\Helge\AppData\Roaming\Microsoft\Templates\"
With Workbooks.Open(Path & Template)
.Sheets(TabId).Copy After:=Wb.Sheets(Wb.Sheets.Count)
.Close
End With
Set AddWorksheet = ActiveSheet
If Len(TabName) Then ActiveSheet.Name = TabName
End Function
You can call the function from a sub routine like this:-
Sub AddWorksheets()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Application.ScreenUpdating = False
Set Tab1 = AddWorksheet("Page1.xltx", 1, "New Tab")
Set Tab2 = AddWorksheet("Page2.xltx", "Sheet1", "Another new Tab")
Application.ScreenUpdating = True
End Sub
Please observe the difference between the two function calls.
Trying to create a excel worksheet using data from a VBA form then adding it to end of workbook. Please help to activate the code
Private Sub Add_Tab_Click()
Dim txtNameSur As Worksheet
Set txtNameSur = Worksheets("Me.Textbox1")
ThisWorkbook.Sheets(1).Copy after:=Sheets(Sheets.Count)
Newname = Worksheets.Add.Name = Userform1.txtNameSur.Value
ActiveSheet.Name = Newname
End Sub
The goal in your question is a bit unclear, but I guess you meant to do something like below:
Private Sub Add_Tab_Click()
'copy first worksheet to the end of the workbook
ThisWorkbook.Worksheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'set the copied worksheet to a variable `NewWorksheet`
Dim NewWorksheet As Worksheet
Set NewWorksheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'last one is the copied one
'give it a new name (use the text in Textbox1 as name)
NewWorksheet.Name = Me.Textbox1.Text
End Sub
I've encountered a strange thing: I've joined three workbooks: Personal Data Tracker, Global Tracker and the workbook with pivots and charts. The logic is as it follows: the user clicks on a button after the work is finished so the data is copied to the GL Tracker. Once the change event is triggered in the GL Tracker Table, the last workbook opens, the pivot is refreshed upon the open vent and the wb is closed.
Everything seems to be working fine, however when I run the macro live, at the very end I get an error message about
"Application-defined or object-defined error".
Only OK and Help button displayed, it doesn't make the VBE Open so I could debug it.
Would anyone know what it may be happening even if the whole chain works fine?
Thank you.
Code from the Personal Tracker:
Sub test()
Dim path As String
Dim wb As Workbook
path = ThisWorkbook.path & "\Dest.xlsm"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Total").Range("R1").Value = Date
Range("R1").Font.Color = VBA.ColorConstants.vbWhite
Worksheets("TOTAL").Range("B2:B13").Copy
On Error GoTo Handler
Workbooks.Open (path)
On Error GoTo 0
Set wb = Workbooks("Dest")
Worksheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues
Exit Sub
Handler:
MsgBox "Someone else is saving their data at the moment." & vbNewLine & _
"Please try in a few seconds"
End Sub
Code from the GL Tracker:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MRange As Range
Dim wbPivot As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
Dim Name As String
Dim answer As VbMsgBoxResult
Set MRange = ThisWorkbook.Sheets(1).Range("Table1")
Name = Application.UserName
Application.ScreenUpdating = False
If Not Intersect(Target, MRange) Is Nothing Then
Application.EnableEvents = True
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Pivot.xlsm")
End If
'refresh
For Each ws In wbPivot.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.Refresh
pt.Update
pt.RefreshTable
Next
Next
'saving
Application.ScreenUpdating = True
If Application.UserName <> "Jakub Tracz" Then
MsgBox "User not authorised. Workbook will be closed."
wbPivot.Close True
ThisWorkbook.Close True
Else
answer = MsgBox(Prompt:="Do you want to save and close the workbook?", _
Buttons:=vbYesNo + vbQuestion)
Select Case answer
Case vbYes
wbPivot.Close True
ThisWorkbook.Close True
Case vbNo
MsgBox "Welcome, " & Application.UserName
End Select
End If
End Sub
I'm going to give you a proof of concept code as an example for you to use. This will not exactly answer your question with code you can just copy/paste, but you will be able to use this to put it together the way you want it to work instead of me making assumptions about many things and restructuring it myself.
This simply demonstrates how to use a workbook object variable in one routine that can reference another workbook, and how to make changes to that 2nd workbook and save/close it.
Sub Tracker_Update()
Dim wbPivot as Workbook
' open the workbook
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Test.xlsx")
' optionally make it hidden
wbPivot.Visible = False
With wbPivot
' pretend this code updates the pivot table
.Worksheets(1).Range("A1") = "hello world"
' Close and save it
.Close True
End With
' optionally clear the variable
' this is not really needed in VBA, but if you eventually
' start using VB.NET with Excel as a COM object,
' you will want to know how to do this part when you are done
Set wbPivot = Nothing
End Sub
I think you will like this approach in the end much better in the end anyway, as the code isn't scattered around so much in different places. Easier to debug later, and easier for someone else to understand what you are doing if and when you leave the company.
I have a userform that fills out a row of information into an excel sheet. The excel sheet has two spreadsheets, one for data entry, and one for the 3 droplists that are in the userform. I want to delete this second sheet and make it into its own workbook. My question here is how can I write the VBA code to select the data from the droplist workbook (called "Client and Project Droplists.xlsx") to populate the droplists in the userform in the first workbook (called "Expense Reports Test.xlsm")? My current code is attached below.
Private Sub cboClient_Change()
Me.cboProject = ""
Select Case Me.cboClient
Case "Wells Fargo"
Me.cboProject.RowSource = "WellsFargoProjects"
Case "BLUSA"
Me.cboProject.RowSource = "BLUSAProjects"
Case "JP Morgan"
Me.cboProject.RowSource = "JPMProjects"
End Select
End Sub
I will be at work for the next few hours so any additional information can be requested in the questions/comments section. Would really appreciate help on this task.
My co-worker and I share a lot of data and work in excel quite a bit, so we have created quite a few shared tables on network drives for use in our utilities.
One method we have employed is opening a global list, copying it locally, and using it to populate a dropdown:
Sub GetStatusCodeList()
Dim ThisWb
Set ThisWb = ThisWorkbook
If Dir("\\SERVERNAME\GlobalUtilities\GlobalTables.xlsx") = "" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Open "\\SERVERNAME\GlobalUtilities\GlobalTables.xlsx", ReadOnly:=True
ActiveWorkbook.Sheets("GlobalTables").UsedRange.Copy ThisWb.Sheets("DropDown").Range("A1")
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Another method simply reads the cells from a global list and writes them directly into the conditional formatting list. This particular code creates an array of available sheets and uses it to populate a dropdown:
Sub CreateSheetDropdown()
Dim sheetCounter, i
Dim theSheets() As String
ReDim theSheets(ActiveWorkbook.Sheets.Count + 1) As String
For i = 1 To ActiveWorkbook.Sheets.Count
theSheets(i) = ActiveWorkbook.Sheets(i).Name
Next i
With ThisWb.Sheets(Mtab).Range("SourceTabName")
.Value = theSheets(1)
.Validation.Delete
'.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
' Operator:=xlBetween, Formula1:=Join(theSheets, ",")
.Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Join(theSheets, ",")
.Validation.ShowError = False
.Interior.color = RGB(250, 200, 200)
End With
End Sub
Finally, this code creates a dropdown in a userform from a global list that we keep on our shared drive:
Private Sub UpdateDropdowns()
Dim thisWorkbook
Set thisWorkbook = ActiveWorkbook
If Dir(TABLEPATH) = "" Then
MsgBox ("GlobalTables File Not Found - Critical Error")
Me.Hide
Exit Sub
End If
Workbooks.Open Filename:=TABLEPATH, ReadOnly:=True
'---------------------------------------------
'Method would load from GlobalTables.xlsx
'---------------------------------------------
'Load Utility Names
For Each c In ActiveWorkbook.Sheets(UTIL_SHEET).Range("A2:A" & ActiveWorkbook.Sheets(UTIL_SHEET).Cells(ActiveWorkbook.Sheets(UTIL_SHEET).Rows.Count, "A").End(xlUp).row).Cells
AddUtilToAll (c.Value)
Next c
End Sub
Private Sub AddUtilToAll(ByVal s)
For Each c In Me.Controls
If InStr(c.Name, "UtilityCombo") Then c.AddItem (s)
Next c
End Sub
Probably the easiest method to employ is the first one - just open the workbook stored on a shared drive and copy each dropdown list locally. You can run this in the Worksheet initialize function so that the dropdowns are updated each time you open the file.
Hope this helps, let me know if you want more information.
Edit:
It's probably easier to read here.
Just link your dropdown to a named range:
'Delete the old named range
ThisWorkbook.Names("TestDropdown").Delete
'Define the new named range
ThisWorkbook.Names.Add Name:="TestDropdown", RefersTo:=Range("A1:A25")
I have a materials register I am creating
Due to regulation when a material (each material has its own worksheet with a 3 digit random number added on the end to allow the same name multiple times) is deleted it cannot actually be deleted, so to work around this my workbook hides the sheet and using a deletion check on the summary page hides the appropriate row.
However what I am struggling with is a function to restore the sheet,
I have the code I need to do this however I cannot find any function to list hidden sheets.
This list can be put into the work book in a hidden column so I can reference it with my macro but as I said I cannot find anyway to list only sheets that are hidden.
Thanks for your help
You could add to your code that does the hiding to write the name of the sheet that it is hiding to your other hidden tab, and add the reverse to your code that unhides it.
Not sure if the below is applicable to your situation, but you could also put some code in worksheet events to capture when the sheet is being made invisible
Private Sub Worksheet_Deactivate()
If Me.Visible = xlSheetHidden Then MsgBox "I have been hidden"
End Sub
Does this help ..
' Function to be used in array formula on sheet to list hidden sheets
Public Function ListHiddenSheets()
Dim hiddenSheets As New dictionary
Dim sheet As Worksheet
For Each sheet In Worksheets
If sheet.Visible <> xlSheetVisible Then hiddenSheets.Add sheet.Name, Null
Next sheet
Dim vRes() As Variant
ReDim vRes(0 To hiddenSheets.Count, 0 To 0)
Dim idx As Integer
For idx = 0 To hiddenSheets.Count - 1
vRes(idx, 0) = hiddenSheets.keys(idx)
Next idx
ListHiddenSheets = vRes
End Function
?
Hidden sheets can be Hidden or VeryHidden, to capture these:
ub ListEm()
Dim ws As Worksheet
Dim StrHid As String
Dim strVHid As String
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Visible
Case xlSheetVisible
Case xlSheetHidden
StrHid = StrHid & ws.Name & vbNewLine
Case Else
strVHid = strVHid & ws.Name & vbNewLine
End Select
Next
If Len(StrHid) > 0 Then MsgBox StrHid, vbOKCancel, "Hidden Sheets"
If Len(strVHid) > 0 Then MsgBox strVHid, vbOKCancel, "Very Hidden Sheets"
End Sub