Altering code to reference the worksheet before the active worksheet

[KimberlyC]

Hi
I'm using the following code (with the help of this newsgroup) to create and
update a list on a separate worrksheet. The users input the data into cells
A8:A501 of the Active worksheet, and the list is recapped (created) with no
duplicates or spaces on another worksheet (called "Adjustments") in cells
A8:A47.

Here is the code used in the Active worksheet's module:

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="test"
If Not Application.Intersect(Target, _
Range("A8:A501")) Is Nothing Then
ActiveWorkbook.Sheets("Adjustments").Range("A8:A47").ClearContents
gCopyUnique Range("A8:A501"),
ActiveWorkbook.Sheets("Adjustments").Range("A8")
End If

ActiveSheet.Unprotect Password:="test"
'Range("R16:R51").Select
ActiveWorkbook.Sheets("Adjustments").Range("A8:A47").Sort
Key1:=ActiveWorkbook.Sheets("Adjustments").Range("A8"),
Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect Password:="test", DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub


Here is the other part of the code that is located in the workbook's
standard module:

Public Sub gCopyUnique(rrngSource As Range, rrngDest As Range)
ActiveSheet.Unprotect Password:="test"
rrngSource.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=rrngDest, Unique:=True
ActiveSheet.Protect Password:="test", DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub


Here is my question... This code is working great...but I need to know if
there is a way to alter the above to code to make it reference the worksheet
"before" the Active Worksheet .... instead of the "Adjustments" worksheets
as shown above.

The name of the "Adjustments" worksheet will change as the users add more
sheets to the workbook (via code in an addin file)
I can continue to use the Active worksheet part of the code above...but the
part where it references the "Adjustments" worksheet..will not work.. if the
worksheet has the name "Adjustments (2)"...and so on.. but...it will always
be the worksheet before the one were the users enter the data into..which is
the active worskheet.

Any help is greatly appreciated...
Thanks in advance!
Kimberly

 

[Bob Phillips]

Depends what you mean by before. If you just mean the one to the left in the
tab layout then you can get that worksheet with

With Activesheet
If .Index = 1 Then
Msgbox "No sheets to the left"
Else
Set mySheet = Worksheets(.Index - 1)
End If
End With

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[KimberlyC]

Thanks Bob...
I do mean the one to the left in the tab layout.
How do I incorparate this code with mine.....
Thanks again..

 

[KimberlyC]

I figured it out...
I used "mysheet" in place of ActiveWorkbook.sheets ("Adjustments")

Thanks again!
Works Great now!!

 

[Bob Phillips]

God, I was hoping to avoid that

Private Sub Worksheet_Change(ByVal Target As Range)
Dim prevSheet As Worksheet

With Me

If .Index = 1 Then
MsgBox "No sheets to the left"
Set prevSheet = Worksheets("Adjustments")
Else
Set prevSheet = Worksheets(.Index - 1)
End If

.Unprotect Password:="test"

If Not Application.Intersect(Target, _
Range("A8:A501")) Is Nothing Then
mySheet.Range("A8:A47").ClearContents
gCopyUnique Range("A8:A501"), mySheet.Range("A8")
End If

.Unprotect Password:="test"

'Range("R16:R51").Select
mySheet.Range("A8:A47").Sort _
Key1:=mySheet.Range("A8"), _
Order1:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End With

End Sub

You do realise that if the changed range is not in A8:A501, it will still do
the sort, even though the data was not copied across?

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[David]

KimberlyC wrote

I do mean the one to the left in the tab layout.

I use Activesheet.Previous to refer to the sheet to the left of the one I'm
viewing.
i.e.
Instead of ActiveWorkbook.Sheets("Adjustments").Range
("A8:A47").ClearContents
I would use:
Activesheet.Previous.Range("A8:A47").ClearContents

 

[KimberlyC]

Hey Bob.. While I was waiting for your reply.. I played with the code and
came up with this...
It is working really well...
Will my way ... cause any issues that I'm not aware of?

Private Sub Worksheet_Change(ByVal Target As Range)
With ActiveSheet
If .Index = 1 Then
MsgBox "No sheets to the left"
Else
Set mysheet = Worksheets(.Index - 1)
End If
End With


ActiveSheet.Unprotect Password:="test"
If Not Application.Intersect(Target, _
Range("A8:A501")) Is Nothing Then
mysheet.Range("a8:a47").ClearContents
gCopyUnique Range("A8:A501"), mysheet.Range("A8")
End If
ActiveSheet.Unprotect Password:="test"
mysheet.Range("A8:A47").Sort Key1:=mysheet.Range("A8"),
Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect Password:="test", DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

 

[Bob Phillips]

Hi Kimberley,

Don't think so, it is much the same as mine, I just tried to remove the
repetitive code. I also added a line that sets the sheet to Adjustments if
there are no previous that you may want to incorporate.

BTW, David mentioned the Previous property which I always forget about. You
would use that like so

With ActiveSheet
If .Index = 1 Then
MsgBox "No sheets to the left"
Set mySheet = Worksheets("Adjustments")
Else
Set mysheet = .Previous
End If
End With

very similar, maybe a bit more obvious.

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[KimberlyC]

Thank you so much!

Hi Kimberley,

Don't think so, it is much the same as mine, I just tried to remove the
repetitive code. I also added a line that sets the sheet to Adjustments if
there are no previous that you may want to incorporate.

BTW, David mentioned the Previous property which I always forget about. You
would use that like so

With ActiveSheet
If .Index = 1 Then
MsgBox "No sheets to the left"
Set mySheet = Worksheets("Adjustments")
Else
Set mysheet = .Previous
End If
End With

very similar, maybe a bit more obvious.

--

HTH

RP
(remove nothere from the email address if mailing direct)