How can I set the same variant to multiple sheets?

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118
if I have code such as this..

Code:
Dim es As Worksheet, etd As Worksheet
Set es = Worksheets("Master Employee List")
Set etd = Worksheets("Jan Week 1")

You can see "es" & "etd" are being declared, and set to Jan Week 1 worksheet.

How can I write this to accept for example where I have quite a few more sheets to add.

Code:
Set etd = Worksheets("Jan Week 1"),("Jan Week 2"),("Jan Week 3"),("Jan Week 4")

I have like 50+ sheets I'd like to assign this way. Do I need to set these as an array or is there perhaps an easier way to do it?

"etd" would be the same across all sheets, so I'm trying to learn a bit on how to use the same variant across all the sheets I'm looking for.
 
Last edited:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,002
Office Version
  1. 365
Platform
  1. Windows
You can do it like this using an array
Code:
Dim etd() As Worksheet, sht As Worksheet, i As Long
ReDim etd(Worksheets.Count)
For Each sht In Worksheets
   Set etd(i) = sht
   i = i + 1
Next sht

MsgBox etd(0).name
 

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118
Firstly, thank you for the reply. I must ask though, how does this reference only the weeks I would like? Like Jan Week 1, Jan Week 2, Jan Week 3, Jan Week 4, Feb Week 1, etc, etc..

I have like 200 sheets, and only 50 I need to reference, not every sheet in the workbook. I know I need to declare what's in the array, but my lack of experience isn't allowing my brain to type it right.. lol
 
Last edited:

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,932
Office Version
  1. 2019
Platform
  1. Windows
Hi,

Try

Code:
Dim es As Worksheet, etd() As Worksheet
Dim i As Integer, a As Integer


Set es = Worksheets("Master Employee List")


ReDim etd(1 To Worksheets.Count)
For i = 1 To Worksheets.Count
    If Worksheets(i).Name Like "*Week*" Then
        a = a + 1
        Set etd(a) = Worksheets(i)
    End If
Next i


'resize array
ReDim Preserve etd(1 To a)


'example use
For i = 1 To UBound(etd)
    MsgBox etd(i).Name
Next i

Dave
 
Last edited:

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118

ADVERTISEMENT

I tried this.. However I'm only getting it on ONE of my test pages.. Here's my full code. Your help in red. I Have (2) sheets I'm working with for testing. "Jan Week 1" and "Jan Week 2" and this data is only going in Jan Week 2 for some reason.. I didn't get any errors though! haha. I also provided my original code before I started to tie in multiple sheets on the bottom.

Code:
Sub Delete_employee()On Error Resume Next
Set myRange = Application.InputBox(Prompt:="Please click on the Employee you want to remove", _
Title:="Click on employee", Type:=8)
r1 = myRange.Row
c1 = myRange.Column
If myRange Is Nothing Then Exit Sub
emp = Cells(r1, c1).Value


x = InputBox("This action CANNOT be undone! Type YES to delete  - " & emp)
If UCase(x) <> "YES" Then
    MsgBox "Employee NOT deleted"
    Exit Sub
End If


[COLOR=#ff0000]Dim es As Worksheet, etd() As Worksheet
Dim i As Integer, a As Integer[/COLOR]




[COLOR=#ff0000]Set es = Worksheets("Master Employee List")
[/COLOR]



[COLOR=#ff0000]ReDim etd(1 To Worksheets.Count)
For i = 1 To Worksheets.Count
    If Worksheets(i).Name Like "*Week*" Then
        a = a + 1
        Set etd(a) = Worksheets(i)
    End If
Next i
[/COLOR]



[COLOR=#ff0000]'resize array
ReDim Preserve etd(1 To a)[/COLOR]


r = Application.Match(emp, es.Range("A:A"), 0)
es.Rows(r).Cut
es.Rows(Range("A" & Rows.Count).End(xlUp).Offset(37).Row).Insert
es.Rows(Range("D37").Row).ClearContents


m = Application.Match(emp, etd([COLOR=#ff0000]a[/COLOR]).Range("D:D"), 0)
etd([COLOR=#ff0000]a[/COLOR]).Rows(m).Cut
etd([COLOR=#ff0000]a[/COLOR]).Rows(Range("D" & Rows.Count).End(xlUp).Offset(43).Row).Insert
etd([COLOR=#ff0000]a[/COLOR]).Rows(Range("D43").Row).ClearContents


'WORKING OLD
'etd.Rows(i).Delete Shift:=xlUp
MsgBox emp & (" Was Deleted Succesfully")


Call Fill_it


End Sub
Sub Add_employee()




[COLOR=#ff0000]Dim es As Worksheet, eta() As Worksheet
Dim i As Integer, a As Integer




Set es = Worksheets("Master Employee List")




ReDim eta(1 To Worksheets.Count)
For i = 1 To Worksheets.Count
    If Worksheets(i).Name Like "*Week*" Then
        a = a + 1
        Set eta(a) = Worksheets(i)
    End If
Next i




'resize array
ReDim Preserve eta(1 To a)
[/COLOR]

lr = es.Cells(Rows.Count, "A").End(xlUp).Row + 1
lrp = eta([COLOR=#ff0000]a[/COLOR]).Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).Row
'lrp = eta.Cells(Rows.Count, "D").End(xlUp).Row
es.Cells(lr, "A") = InputBox("Enter employee Name (First Then Last)")
eta([COLOR=#ff0000]a[/COLOR]).Cells(lrp, "D") = InputBox("Please Re-enter the employee name (First Then Last)")


Call Fill_it


End Sub
Sub Fill_it()


Dim es As Worksheet, Ws As Worksheet
Set es = Worksheets("Master Employee List")
Set Ws = Worksheets("Employee List")


wr = 2
For C = 3 To 28 Step 5
For r = 8 To 33 Step 5
Ws.Cells(r, C) = es.Cells(wr, "A")
wr = wr + 1
Next r
Next C


End Sub



Original Code. (Where I'm trying to reference multiple sheets... This code works flawlessly to do my changes to "Jan Week 1")

Code:
Sub Delete_employee()On Error Resume Next
Set myRange = Application.InputBox(Prompt:="Please click on the Employee you want to remove", _
Title:="Click on employee", Type:=8)
r1 = myRange.Row
c1 = myRange.Column
If myRange Is Nothing Then Exit Sub
emp = Cells(r1, c1).Value


x = InputBox("This action CANNOT be undone! Type YES to delete  - " & emp)
If UCase(x) <> "YES" Then
    MsgBox "Employee NOT deleted"
    Exit Sub
End If


Dim es As Worksheet, etd As Worksheet
Set es = Worksheets("Master Employee List")
Set etd = Worksheets("Jan Week 1")


r = Application.Match(emp, es.Range("A:A"), 0)
es.Rows(r).Cut
es.Rows(Range("A" & Rows.Count).End(xlUp).Offset(37).Row).Insert
es.Rows(Range("D37").Row).ClearContents


m = Application.Match(emp, etd.Range("D:D"), 0)
etd.Rows(m).Cut
etd.Rows(Range("D" & Rows.Count).End(xlUp).Offset(43).Row).Insert
etd.Rows(Range("D43").Row).ClearContents




MsgBox emp & (" Was Deleted Succesfully")


Call Fill_it


End Sub
Sub Add_employee()


Dim es As Worksheet, eta As Worksheet
Set es = Worksheets("Master Employee List")
Set eta = Worksheets("Jan Week 1")


lr = es.Cells(Rows.Count, "A").End(xlUp).Row + 1
lrp = eta.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).Row
'lrp = eta.Cells(Rows.Count, "D").End(xlUp).Row
es.Cells(lr, "A") = InputBox("Enter employee Name (First Then Last)")
eta.Cells(lrp, "D") = InputBox("Please Re-enter the employee name (First Then Last)")


Call Fill_it


End Sub
Sub Fill_it()


Dim es As Worksheet, Ws As Worksheet
Set es = Worksheets("Master Employee List")
Set Ws = Worksheets("Employee List")


wr = 2
For C = 3 To 28 Step 5
For r = 8 To 33 Step 5
Ws.Cells(r, C) = es.Cells(wr, "A")
wr = wr + 1
Next r
Next C


End Sub
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,002
Office Version
  1. 365
Platform
  1. Windows
You need to loop through the array like
Code:
Dim i As Long
For i = 1 To UBound(etd)
   m = Application.Match(emp, etd(i).Range("D:D"), 0)
   etd(i).Rows(m).Cut
   etd(i).Rows(Range("D" & Rows.Count).End(xlUp).Offset(43).Row).Insert
   etd(i).Rows(Range("D43").Row).ClearContents
Next i
 

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118

ADVERTISEMENT

I apologize, but I'm a little confused here.. I tried this yesterday for about an hour, and wasn't able to get it working. Would you be able to put this into my full original code? I must have done something wrong along the way, but everytime I go through it I'm having a hard time understanding where the problem is. I'm still pretty inexperienced with most of this stuff.. It's kind of a lot to take in. haha. Luckily for me though, I won't need any more code after this.. (I hope!) I have a good understanding on how it works, but the literature is still catching up to me.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,002
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
Sub Delete_employee()
Dim i As Long

Set MyRange = Application.InputBox(prompt:="Please click on the Employee you want to remove", _
Title:="Click on employee", Type:=8)
r1 = MyRange.Row
c1 = MyRange.Column
If MyRange Is Nothing Then Exit Sub
emp = Cells(r1, c1).Value


x = InputBox("This action CANNOT be undone! Type YES to delete  - " & emp)
If UCase(x) <> "YES" Then
    MsgBox "Employee NOT deleted"
    Exit Sub
End If


Dim es As Worksheet, etd() As Worksheet
Dim i As Integer, a As Integer




Set es = Worksheets("Master Employee List")




ReDim etd(1 To Worksheets.Count)
For i = 1 To Worksheets.Count
    If Worksheets(i).name Like "*Week*" Then
        a = a + 1
        Set etd(a) = Worksheets(i)
    End If
Next i




'resize array
ReDim Preserve etd(1 To a)


r = Application.Match(emp, es.Range("A:A"), 0)
es.Rows(r).Cut
es.Rows(Range("A" & Rows.Count).End(xlUp).Offset(37).Row).Insert
es.Rows(Range("D37").Row).ClearContents

For i = 1 To UBound(etd)
   m = Application.Match(emp, etd(i).Range("D:D"), 0)
   etd(i).Rows(m).Cut
   etd(i).Rows(Range("D" & Rows.Count).End(xlUp).Offset(43).Row).Insert
   etd(i).Rows(Range("D43").Row).ClearContents
Next i


'WORKING OLD
'etd.Rows(i).Delete Shift:=xlUp
MsgBox emp & (" Was Deleted Succesfully")


Call Fill_it


End Sub
 

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118
I tried to get that working, but it still gave me an error.

---------------------------
Microsoft Visual Basic for Applications
---------------------------
Compile error:


Duplicate declaration in current scope
---------------------------
OK Help
---------------------------


I tried to change Dim I as Integer to Dim O, but I still got some errors. Unfortunately for me I'm too inexperienced to track down the issue myself. I really do appreciate the help so far though. We're close! I can feel it..
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,002
Office Version
  1. 365
Platform
  1. Windows
Compile error:


Duplicate declaration in current scope
Means that you have 2 (or more) macros with the same name in the module.
Either delete one of them, or rename one of them.
 

Forum statistics

Threads
1,148,291
Messages
5,745,892
Members
423,983
Latest member
blackworx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top