PDA

View Full Version : [SOLVED:] For each sheet in between two sheets criteria - VBA



Jovannivk
04-06-2022, 03:34 PM
Hi all,

So for this task I'll be needing to adjust sheets based on their sheet names, but I want VBA to recognize which these are.

The code I'm using right now first on the criteria that they start with XXXX, because I know they start with XXXX in this specific case. However, if I want to elaborate there will be sheets other values. Therefore, what I need is a somewhat similar piece of code that recognizes them but is not dependent on XXXX only. I was thinking something about if these sheets are between sheet 1 and sheet 5, then I need sheet 2,3,4 to execute some tasks. Namely, to copy and paste all the cells from the "Template" sheet, correct cell c12 to the sheet name and change the tab color of the sheet.

What I got right now is the following:


Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 4) = "XXXX" Then
Sheets("Template").Select
Cells.Select
Selection.Copy
ws.Activate
ActiveSheet.Paste
ActiveSheet.Range("c12").Value = ActiveSheet.Name 'Copy sheet name as property input within the sheet

With ws.Tab
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314 'Adds a color to property tabs only
End With
End If
Next ws


I am hoping someone has an idea for my problem as I cannot figure this one out. I am open to any comments or points for improvement (also to the code I already have).

Thanks in advance.

Paul_Hossler
04-06-2022, 04:53 PM
I would not rely on the order of worksheets, or their tab names

The CodeName is much more reliable

So 'Template' is the internal (name) = CodeName under your control and Name = 'Day Zero' is what the user sees



Option Explicit

Sub Test()


MsgBox Template.Cells(1, 1).Value
MsgBox Worksheets("Day Zero").Cells(1, 1).Value


MsgBox Template.CodeName
MsgBox Worksheets("Day Zero").CodeName



Worksheets("Day Zero").Name = "NOT Day Zero"
MsgBox Template.Cells(1, 1).Value


End Sub

SamT
04-06-2022, 05:38 PM
Themes adds much to Workbook Sizes. I won't use Themes unless the business that owns the book insists.

Paul is correct, the use of CodeNames is preferred in VBA.

There are two methods other than "XXXX". Inclusive and Exclusive

Inclusive:

Dim Included as String
Included = "sheet1Name,Sheet2Name,etc"

for each ws
If CBool(Instr(Included, ws.Name)) Then do stuff
'Yeah, I know CBool is supposed to be redundant. Like I trust MS.

Exclusive:

Dim Excluded As String
Excluded = "Sh1Name,Sh2Name,etc"

For Each ws
If Not CBool(Instr(Excluded, ws.Name)) Then Do Stuff

Cleaning up your Macro and making it a Procedure:

Sub SamT
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
'Replace below line with Inclusive or Exclusive
If CBool(Instr(ws.Name, "XXXX")) Then
Sheets("Template").Cells.Copy .Cells
.Range("C12").Value = .Name 'Copy sheet name as property input within the sheet
.Tab.Color = vbGreen
End If
Next ws
End Sub

Aflatoon
04-07-2022, 01:28 AM
If you want to do it based on position:


With ThisWorkbook Dim FromIndex As Long: FromIndex = .Worksheets("Sheet1").Index
Dim ToIndex As Long: ToIndex = .Worksheets("Sheet5").Index
Dim shtNum As Long
For shtNum = FromIndex + 1 To ToIndex - 1
.Worksheets("Template").UsedRange.Copy Destination:=.Worksheets(shtNum).Range("A1")
With .Worksheets(shtNum)
.Range("c12").Value = .Name 'Copy sheet name as property input within the sheet

With .Tab
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314 'Adds a color to property tabs only
End With
End With
Next shtNum
End With

snb
04-07-2022, 03:06 AM
Sub M_snb()
For Each it In Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name))
Sheets(1).UsedRange.Copy it.Cells(1)
it.Cells(12, 3) = it.Name
it.Tab.ThemeColor = 10
it.Tab.TintAndShade = 0.8
Next
End Sub
But if I understand you correctly you want to copy the templae sheet 3 times after the first (template) sheet.
In that case you could use:

Sub M_snb()
For j = 1 To 3
Sheets(1).Copy , Sheets(1)
With Sheets(2)
.Cells(12, 3) = .Name
.Tab.ThemeColor = 10
.Tab.TintAndShade = 0.8
End With
Next
End Sub

Jovannivk
04-08-2022, 03:01 AM
Thank you all for the help guys, the code works :hi: