I intend to rename all the sheets with the cell "G2" value except the two sheets called "Main" and "Fixed".
The code keeps renaming the two sheets.
Sub RenameSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'With ActiveWorkbook.ActiveSheet
If ActiveWorkbook.ActiveSheet.Name <> "Main" Or _
ActiveWorkbook.ActiveSheet.Name <> "Fixed" Then
ws.Activate
If Range("G2").Value = "" Then
ActiveSheet.Name = Range("G2").End(xlDown).Value
Else: ActiveSheet.Name = Range("G2").Value
End If
Else:
GoTo Nextsv
End If
Nextsv: Next ws
Sheets("Main").Activate
ActiveSheet.Cells(1, 1).Select
End Sub
Your code had 3 mistakes
You were using Activate and Active which produced the second error. Read this on how to avoid these.
You were checking the name of the ActiveSheet before the ws.Activate so it would always check the previous sheet.
Your conditions were with Or. Main <> Fixed so it would change their name anyways because Main is not Fixed and mets the second part of your Or and viceversa. Use And to force the code check that both conditions are met.
This is the code without using Activate or Select:
Option Explicit
Sub RenameSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Main" And ws.Name <> "Fixed" Then
With ws
If .Range("G2") = vbNullString Then
.Name = .Range("G2").End(xlDown)
Else
.Name = .Range("G2")
End If
End With
End If
Next ws
End Sub
Related
I don't know why am getting out of range subscript error. When I click on combobox1 and select an item, MaternityForm combobox is populated with worksheets in my workbook. Then I want to hide other worksheets apart from the one selected in MaternityForm. The active sheet will then receive data from userform but I am getting subscript out of range error..
Private Sub Get_Data_Click()
Dim ws As Worksheet
Dim xWs As Worksheet
For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.Visible = True
Next
Set ws = Worksheets(MaternityForm.Value)
Sheets(MaternityForm.Value).Activate
On Error Resume Next
For Each ws In Application.ActiveWorkbook.Worksheets
if ws.Name <> MaternityForm.Value Then
ws.Visible = xlSheetHidden
End If
Next
With Sheets(MaternityForm.Value)
.Range("B3").Value = Me.NameBox.Text
.Range("f3").Value = Me.PaynoBox.Text
.Range("B6").Value = Me.DTPicker1.Value
.Range("B7").Value = Me.DTPicker2.Value
.Range("B17").Value = Me.FirstPayBox.Value
.Range("B18").Value = Me.SecondPayBox.Value
.Range("B25").Value = Me.MonthlyPayBox.Value
.Range("H7").Value = Me.DTPicker3.Value
End With
End Sub
You are confusing your variables ws and xWs.
ws is referring to a specific sheet while xWs is your variable worksheet.
Therefore, your second loop is invalid (This is like saying For Each Sheet1 in Worksheets).
You need to loop through your variable worksheets and compare them to your specific sheet
For Each xWs In Application.ActiveWorkbook.Worksheets
if xWs.Name <> ws.Name Then
xWs.Visible = xlSheetHidden
End If
Next
With that being said, there is no need to loop twice.
Note that ws.Name = MaterityForm.Value will return either TRUE or FALSE. The result of this determines ws.Visible = TRUE/FALSE
Private Sub Get_Data_Click()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Visible = ws.Name = MaternityForm.Value
Next ws
With Sheets(MaternityForm.Value)
.Range("B3").Value = Me.NameBox.Text
.Range("f3").Value = Me.PaynoBox.Text
.Range("B6").Value = Me.DTPicker1.Value
.Range("B7").Value = Me.DTPicker2.Value
.Range("B17").Value = Me.FirstPayBox.Value
.Range("B18").Value = Me.SecondPayBox.Value
.Range("B25").Value = Me.MonthlyPayBox.Value
.Range("H7").Value = Me.DTPicker3.Value
End With
End Sub
I am trying to copy and paste information to certain worksheets. Most of the worksheet names I already know, but there could be one new worksheet added in, which I wouldn't know the name of.
There are 3 worksheets (let's call them WorkSheet1, WorkSheet2, and WorkSheet3) that I don't want to change. I want to copy some values from WorkSheet2 and paste them in all worksheets except 1-3. So far, I have an IF statement with the worksheets I know the names of (WorksheetX,Y, and Z). I am having trouble with the last instance where I wouldn't know the worksheet's name. I have been thinking of using an Or. Here is what I have so far:
Dim ws As Worksheet
Dim og As Worksheet
Set og = Sheets("WorkSheet2")
For Each ws In Worksheets
If ws.Name = "WorkSheetX" Then
og.Range("A1").Copy
Sheets("WorkSheetX").Range("L4").PasteSpecial
ElseIf ws.Name = "WorkSheetY" Then
og.Range("A1").Copy
Sheets("WorkSheetY").Range("L4").PasteSpecial
ElseIf ws.Name = "WorkSheetZ" Then
og.Range("A1").Copy
Sheets("WorkSheetZ").Range("L4").PasteSpecial
'This is where I am having trouble. I won't know the name of the new sheet
'Just that it wont be WorkSheet1,2,3,X,Y, or Z
ElseIf (ws.Name <> "WorkSheet1" Or ws.Name <> "WorkSheet2"
Or ws.Name <> "WorkSheet3" Or ws.Name <> "WorkSheetX" Or
ws.Name <> "WorkSheetY" Or ws.Name <> "WorkSheetZ") Then
og.Range("A1").Copy
ws.Range("L4").PasteSpecial
End If
Next
Here is a simple code to accomplish your task.
Dim ws As Worksheet
'Change the sheet names you don't want to perform you copy_paste
Sheets(Array("Sheet1", "Sheet2", "Sheet4", "Sheet_n")).Visible = False
For Each ws In Application.ThisWorkbook.Worksheets
If ws.Visible = True Then
ws.Range("L4").Value = ws.Range("A1").Value
End If
Next ws
Sheets(Array("Sheet1", "Sheet2", "Sheet4", "Sheet_n")).Visible = True
A Few Worksheets
Option Explicit
Sub AFewWorksheets()
Dim ws As Worksheet
Dim og As Worksheet
Set og = Sheets("WorkSheet2")
For Each ws In Worksheets
Select Case ws.Name
Case "Worksheet1", "Worksheet2", "Worksheet3"
Case Else
og.Range("A1").Copy
ws.Range("L4").PasteSpecial
End Select
Next
End Sub
I would like to write a vba code that will not allow to add duplicate sheets with same name. I have a code that is assigned to button on the sheet that is used to change the name of the active sheet.
Sheets are copied from "Main" sheet and hence all the sheets will have button to rename the sheet based on the value selected in the cells A8 and K11 (Both these cells have drop down list with values).
My concern is when user selects the button to rename the sheet, it should look for all the sheets in workbook and display a message if duplicate sheet exists else it should rename the sheet. I am confused in passing values, I am still a starter. Please help
Sub RenameCurrentSheet()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim ws As Worksheet
ThisWorkbook.Unprotect Password:="xyz"
For x = 1 To worksh
If ActiveSheet.Name = "MainSheet" Then
MsgBox "You Cannot Change Name of This Sheet!!!"
Exit For
Else
ActiveSheet.Name = Range("A8").Value & "-" & Range("K11").Value
Exit For
End If
Next x
Application.DisplayAlerts = True
ThisWorkbook.Protect Password:="xyz"
End Sub
To iterate through the worksheets use code like this:
dim wks as Worksheet
for I = 1 to Application.Worksheets.Count
set wks = Application.Worksheets(i)
Debug.Print wks.Name
.... whatever else you want do do
next i
set wks = Nothing ' When done with the object
Just try and reference the worksheet to see if it exists - if it throws an error, then the sheet doesn't exist.
Your code fails as you're always looking at the activesheet, but never changing which sheet is active.
Public Sub CopyAndRenameSheet()
Dim wrkSht As Worksheet
Dim sNewName As String
With ThisWorkbook
'Copy the template to the end of the workbook.
.Worksheets("MainSheet").Copy After:=.Sheets(.Sheets.Count)
'Set reference to last sheet in workbook (the one you've just copied).
Set wrkSht = .Worksheets(.Sheets.Count)
With wrkSht
'Get the new name from the ranges.
sNewName = .Range("A8") & "-" & .Range("K11")
If WorkSheetExists(sNewName) Then
MsgBox "You Cannot Change Name of This Sheet!!!", vbOKOnly + vbCritical
'Do something with the sheet, otherwise you'll be left with a
'sheet called something like "MainSheet (1)".
Application.DisplayAlerts = False
wrkSht.Delete
Application.DisplayAlerts = True
Else
.Unprotect Password:="xyz"
wrkSht.Name = sNewName
.Protect Password:="xyz"
End If
End With
End With
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
This code copies the name to be assigned from the template instead of the ActiveSheet. If you create the name from the active sheet and make sure that the name meets Excel requirements for sheet names, this code ought to work.
I want to print all the sheets in the workbook I am working in except for Three specific sheets called "Front Page", "Data" and "Logs". I've tried with an "and"- and an "or"-statement and wrapped parenthesis around and nothing worked.
Here's the code:
Sub printsheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Front Page" And _
ws.Name <> "Data" And _
ws.Name <> "Logs" Then
ws.PrintOut
End If
Next ws
End Sub
It appears that you have hidden worksheets in your workbook.
Before printing them, you need to unhide them, or check if the worksheet is hidden. Either manually, or (especially if your sheets were hidden programmatically with xlSheetVeryHidden):
ws.Visible = xlSheetVisible ' ADD THIS LINE TO UNHIDE A SHEET
ws.PrintOut
Or
If ws.Visible = xlSheetVisible Then
ws.PrintOut
End if
Try something like this if you do not want to print out hidden worksheets:
Sub printsheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = True Then
If ws.Name <> "Front Page" And _
ws.Name <> "Data" And _
ws.Name <> "Logs" Then
With ws.PageSetup
.PrintArea = "b2:g26" ' USE YOUR PRINTAREA
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
ws.PrintOut
End If
End If
Next ws
End Sub
You can also use one list with the sheets that you don't want to print
Sub printsheets()
Dim dontPrint As Object
Dim ws As Worksheet
Set dontPrint = CreateObject("Scripting.Dictionary")
dontPrint.Add "Front Page", 1
dontPrint.Add "Data", 2
dontPrint.Add "Logs", 3
For Each ws In ActiveWorkbook.Worksheets
If dontPrint.Exists(ws.Name) Then
Else
ws.PrintOut
End If
Next ws
End Sub
I was attempting to loop through every worksheet in every workbook in a folder and make sure only the cells containing formulas were locked. I have already been using code to lock all cells in every worksheet, and code to lock every formula in a worksheet, successfully for a few months, so I basically mashed the two pieces of code together to get this:
Sub LockAllFormulas()
Dim myOldPassword As String
Dim myNewPassword As String
Dim ws As Worksheet
Dim FileName As String
Dim rng As Range
myOldPassword = InputBox(Prompt:="Please enter the previously used password.", Title:="Old password input")
myNewPassword = InputBox(Prompt:="Please enter the new password, if any.", Title:="New password input")
FileName = Dir(CurDir() & "\" & "*.xls")
Do While FileName <> ""
Application.DisplayAlerts = False
If FileName <> "ProtectionMacro.xlsm" Then
MsgBox FileName
Workbooks.Open (CurDir & "\" & FileName)
For Each ws In ActiveWorkbook.Worksheets
If Not Cells.SpecialCells(xlCellTypeFormulas) Is Nothing Then
ActiveWorkbook.ActiveSheet.Unprotect Password:=myOldPassword
ActiveWorkbook.ActiveSheet.Cells.Locked = False
For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas)
rng.Locked = True
Next rng
ActiveWorkbook.ActiveSheet.Protect Password:=myPassword
End If
Next ws
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
FileName = Dir()
Loop
Application.DisplayAlerts = True
End Sub
Every time I run it it shows a 400 error. The error matches one I got whenever the code runs into a sheet that doesn't have any code in it, but I thought I fixed that problem when I added:
If Not Cells.SpecialCells(xlCellTypeFormulas) Is Nothing Then
Any ideas what else could be going wrong?
When working with SpecialCells, you have to be very careful. What I do is I store them in a range sandwiched between OERN and then check of they are not nothing. Here is an example
Dim rng As Range
On Error Resume Next
Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
'
'~~> Rest of the code
'
End If
Applying that to your code will be like this (UNTESTED)
Dim LockedRange As Range
For Each ws In ActiveWorkbook.Worksheets
With ws
On Error Resume Next
Set LockedRange = .Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not LockedRange Is Nothing Then
.Unprotect Password:=myOldPassword
.Cells.Locked = False
LockedRange.Locked = True
.Protect Password:=myPassword
End If
Set LockedRange = Nothing
End With
Next ws