How can I set the same variant to multiple sheets?

F

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

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
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
 
Upvote 0
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:
Upvote 0
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:
Upvote 0
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:
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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..
 
Upvote 0
Compile error:


Duplicate declaration in current scope
Click to expand...
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
VBA hides/unhides columns based upon pivot table and value
Replies
0
Views
126
mapatton
M
C
  • Question
Multiple Workbooks to one.
2
Replies
11
Views
514
dmt32
D
P
  • Question
Automating copying of columns within same sheet in excel using VBA.
Replies
1
Views
105
MountainFog
M
M
  • Question
VBA code to create command button and copy criteria based data from one worksheet to another
2
Replies
13
Views
437
Tupe77
T
F
  • Question
Overlap changing a worksheet using vba macro
Replies
1
Views
152
RoryA
RoryA

Forum statistics

Threads
1,214,646
Messages
6,120,717
Members
448,985
Latest member
chocbudda

Share this page

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
Back
Top