Sub RunMacroOnAllSheetsToRight()
For i = ActiveSheet.Index To Sheets.Count
Call MyFunction(i)
Next i
End Sub
Function MyFunction(i)
'Code goes here
Columns("R:R").ColumnWidth = 8.1
[S1].Resize(, 14).EntireColumn.Insert
MsgBox "I'm currently on sheet " & ThisWorkbook.Sheets(i).name
End Function
I found a sample of code for running macro that should run on all sheets on the right from the active one, but it is not working, it keeps running on one sheets, but the msgbox shows me that the sheets are changed(each time it displays different name). Can you help me? I am new to vba-excel.
You need to activate each sheet. Then activate original sheet.
Sub RunMacroOnAllSheetsToRight()
Dim a As Integer
a = ActiveSheet.Index 'Save current sheet
For i = a To Sheets.Count
Call MyFunction(i)
Next i
Sheets(a).Activate 'At the end, activate original sheet
End Sub
Function MyFunction(i)
'Code goes here
Sheets(i).Activate 'Activate each sheet
Columns("R:R").ColumnWidth = 8.1
[S1].Resize(, 14).EntireColumn.Insert
MsgBox "I'm currently on sheet " & ActiveSheet.Name 'Trustworthy information
End Function
Related
I am trying to put a dynamic protection on the sheets in my workbook. I have many different sheets and sometimes I delete a sheet that I still need by accident.
If Cell OP15 contains a value, this means I am okay to delete the sheet to clean up my workbook. How do I create a protection for the sheets that only lets me delete it if Cell OP15 contains a value?
The closest thing I can find on the internet is something along these lines:
ActiveSheet.Unprotect
' your vba code here
ActiveSheet.Protect
The .BeforeDelete does not have a cancel, so you can't stop them deleting the sheet.
from this website, you can copy the sheet, and save it from deletion that way. You could use this routine to decide if you need to save the sheet from deletion or not:
Private Sub Worksheet_BeforeDelete()
Dim MyName As String
'Abort if no value in OP15
if [OP15].value<>'' then exit sub
‘Capture the original worksheet name
MyName = ThisWorkbook.ActiveSheet.Name
‘Rename the worksheet
ThisWorkbook.ActiveSheet.Name = Left(MyName, 30) + “#”
‘Create a copy of the worksheet
ThisWorkbook.ActiveSheet.Copy _
After:=Sheets(ThisWorkbook.ActiveSheet.Index)
‘Name the copy to the original name
ThisWorkbook.ActiveSheet.Name = MyName
End Sub
This code is pasted into the sheet code for my admin template. Cell A1 is hardcoded to say "admin template". When the template is copied Cell A1 changes to the name of the new tab.
Option Explicit
Private Sub Worksheet_Deactivate()
'This sub prevents acidental deletion of tab until it has been hardcoded
If Range("a1").Value = "admin template Ticket Info" Then
ThisWorkbook.Protect , False
Exit Sub
End If
If Range("OP15").Value <> "" Then
MsgBox "Cannot delete tab until the Onboarding details have been hardcoded."
Exit Sub
End If
ThisWorkbook.Protect , True
Application.OnTime Now, "Unprotectbook"
End Sub
This is copied into one of the modules
Sub UnprotectBook()
ThisWorkbook.Unprotect
End Sub
I have set up a Quality Check sheet which needs to store results in a separate sheet called 'Data' as a row of data, and save an archived version of the full Check Sheet in a separate workbook.
I'm quite a novice on VBA but have managed to get what I need working. My problem comes when I assign the macro to a button which is contained on my check sheet. If I press the button it copies the wrong sheet over and basically does not do what it does when I run the macro manually. Can anyone suggest anything please?
Thanks
My code is as follows:
Sub SaveForm()
' SaveForm Macro
' Saves form data to the Data Sheet
'Checks for completion of mandatory fields
If IsEmpty(Range("b3").Value) = True Then
MsgBox "Please complete 'Agent Name' before saving"
Exit Sub
ElseIf IsEmpty(Range("b4").Value) = True Then
MsgBox "Please complete 'Call ID' before saving"
Exit Sub
ElseIf IsEmpty(Range("b5").Value) = True Then
MsgBox "Please complete 'Call Length' before saving"
Exit Sub
ElseIf IsEmpty(Range("D3").Value) = True Then
MsgBox "Please complete 'Business Name' before saving"
Exit Sub
ElseIf IsEmpty(Range("D4").Value) = True Then
MsgBox "Please complete 'Date of Call' before saving"
Exit Sub
ElseIf IsEmpty(Range("D5").Value) = True Then
MsgBox "Please complete 'Time of Call' before saving"
Exit Sub
ElseIf IsEmpty(Range("b7").Value) = True Then
MsgBox "Please complete 'Assessor Name' before saving"
Exit Sub
ElseIf IsEmpty(Range("b8").Value) = True Then
MsgBox "Please complete 'Date of Assessment' before saving"
Exit Sub
End If
'Copies a range contained within the "Checksheet" and pastes
'it into the next available row on the "Data" sheet
'The reason it is in a straight row as opposed to sporadic cell
'references is because I have set the sheet up this way for simplicity
Range("M14:BP14").Copy
Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveWindow.ScrollRow = 1
Workbooks("Call Feedback Form V0.42.xlsm").Sheets("Checksheet").Activate
Call CopyRenameWorksheet
Workbooks("Call Feedback Form V0.42.xlsm").Sheets("Checksheet").Activate
End Sub
.
Sub CopyRenameWorksheet()
'This renames the worksheet based on cell references and archives to another workbook
Dim ws As Worksheet
Set wh = Worksheets(ActiveSheet.Name)
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
If wh.Range("B3").Value <> "" Then
ActiveSheet.Name = wh.Range("B3").Value & " " & Format(wh.Range("D4").Value, ("yymmdd")) & " " & wh.Range("B4").Value
ActiveSheet.Move After:=Workbooks( _
"Archived Quality Forms.xlsx").Sheets(1)
End If
I think your problem is due to the fact that you are referencing the wrong sheet. Make sure you always fully qualify when you will be using different sheets.
I would start the Subs with
dim ws as worksheet
set ws = Worksheets("Sheetname")
and then you can change all of the ranges to be like ws.range("A1")
This way they will always reference the range on the correct sheet.
I would start by going through your code and making sure that every single reference to a range is referencing a worksheet and a range on said worksheet.
Hope it helps!
Your problem is with this line of code
Range("M14:BP14").Copy
You need to explicitly state what sheet youre referring too. Like i.e.
ThisWorkbook.Sheets("Sheet1").Range("M14:BP14").Copy
I have created a userform frmNavigation which has a ListBox1, which will list down all the worksheets present in my workbook and I can double click on any of worksheet listed in the listbox and go to that sheet.
Now as I have close to 50 worksheets so I double click from the list appearing in ListBox1 and go to that sheet but now I want a back button "CommandButton2" so that it can take me back to my previous active sheet.
I have created a code but its not working.
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim i As Integer, Sht As String
'for loop
For i = 0 To ListBox1.ListCount - 1
'get the name of the selected sheet
If ListBox1.Selected(i) = True Then
Sht = ListBox1.List(i - 1)
End If
Next i
'select the sheet
Sheets(Sht).Select
'reset the userform
Unload Me
frmNavigation.Show
End Sub
Try the code below, I am not sure how to explain my logic of the code below, I tired my best to describe it in the code comments.
I've modified also the ListBox1_DblClick code event, to save the latest ActiveSheet before you Select the new sheet.
Code
Option Explicit
Dim LastSelectedSht As String ' Variable at module level, to store the name of the last selected sheet
'===================================================================
Private Sub CommandButton2_Click()
Dim TmpSht As String
TmpSht = ActiveSheet.Name ' <-- save the current active sheet
' select the previous sheet (stored in LastSelectedSht)
If LastSelectedSht = "" Then
MsgBox "Error, no sheet stored , is it your first time running ? "
Else
Sheets(LastSelectedSht).Select
End If
LastSelectedSht = TmpSht ' <-- use the temp variable to store the latest active sheet
' reset the userform
Unload Me
frmNavigation.Show
End Sub
'===================================================================
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' modifed code for ListBox double-click event, store the sheet name before switching to the selected item
Dim i As Long
LastSelectedSht = ActiveSheet.Name ' <-- save the current active sheet before selecting a new one
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Worksheets(ListBox1.List(i)).Activate
End If
Next i
End Sub
'=================================================================
Private Sub UserForm_Activate()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Me.ListBox1.AddItem ws.Name
Next ws
End Sub
I have a task for school. On my worksheet there is a button with next sheet and previous sheet. But I want that it always checks if possible to move to the next sheet.
For example, three sheets. I start on sheet 1 and click next. Then on sheet 2 I click next. I'm on sheet 3 and I click next, so a message box comes up "there are no sheets left." but if I add another sheet it needs to move on to sheet 4.
Here is the code that I already have:
If ActiveSheet.Index = Worksheets.Count Then
Worksheets(1).Select
Else
ActiveSheet.Previous.Select
End If
If ActiveSheet.Index <> Worksheets.Count Then
ActiveSheet.Next.Select
Else
MsgBox "There are no more sheets left."
End If
if you aim to simply add Command Button to every page then you would have to copy this code in each of the command buttons on all pages(design mode-doubleclick the command button)
Private Sub CommandButton1_Click()
Dim sheetnum As Integer
sheetnum = ActiveSheet.Index
If sheetnum = ThisWorkbook.Sheets.Count Then
ThisWorkbook.Sheets(1).Activate
MsgBox "You are at last sheet returning to the first sheet."
Else
ThisWorkbook.Sheets(sheetnum + 1).Activate
End If
End Sub
Or you would have to create a module and call function from command button.
Like this:
In CommandButton code on every page:
Call newpage
In Module1:
Public Sub newpage()
Dim sheetnum As Integer
sheetnum = ActiveSheet.Index
If sheetnum = ThisWorkbook.Sheets.Count Then
ThisWorkbook.Sheets(1).Activate
MsgBox "You are at last sheet returning to the first sheet."
Else
ThisWorkbook.Sheets(sheetnum + 1).Activate
End If
End Sub
I am working on a dashboard/stats for employees at my company, and I've run into a bit of a hiccup with one of my codes. Here's a bit of background to start
Each employee has 2 sheets with their different stats.
The first sheet is always visible and has a macro that will un-hide and activate the 2nd sheet (so that the workbook doesn't get too unmanageable.) When you click off the 2nd sheet, I have a macro that will hide it (it uses workbook_Sheetdeactivate to close the sheet if it has properties related to the 2nd sheet)
The first sheet's tab-name is added to a cell (in my case range("A62")), with the formula "=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)".
I then make that cell equal to range("A1") on the second sheet. What I want is for the the name of the 2nd sheet to equal range("A1") & " Achievements", so that the 2nd sheet can be referenced in my macros by the first sheet. (Ex: if sheet1 is "Bobby", sheet2 is "Bobby Achievements")
I didn't have trouble writing the macro itself, but I don't know which sub would be best to use so that the macro is activated at the right time. Is there a way to have the macro run whenever a sheetname is changed in the workbook?
Here's the code:
dim ws as worksheet
'Sorting through each sheet to find "Achievement Sheets"
For Each ws in Workbook
If ws.range("W1").Value = "Achievement Lists" Then
ws.name = ws.Range("A1") & " Achievements"
End if
Next ws
It may be a bit crude, but you could simply use the 'Calculate' event on the second worksheet object to update its own name.
Private Sub Worksheet_Calculate()
If Range("A1") & " Achievements" <> Me.Name Then
Me.Name = Range("A1") & " Achievements"
End If
End Sub
or use the 'SheetCalculate event in the workbook object:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
On Error Resume Next
If Sh.Range("W1").Value = "Achievement Lists" Then
If Sh.Range("A1").Value & " Achievements" <> Sh.Name Then
Sh.Name = Sh.Range("A1") & " Achievements"
End If
End If
End Sub