combining two Worksheet_SelectionChange(ByVal Target As Excel.Range) correctly

[cbs81]

Simplifying code,


This may seem like a silly question but im trying to simplify some code.. im an entry level programmer and don’t know how to combine 2 subs that use the selectionchange function…

In the object named ThisWorkbook I have the following code:





Option Explicit
‘a simple unhide function when workbook is opened

Private Sub Workbook_Open()
Dim Sht As Worksheet
Dim SheetsArray As Variant
SheetsArray = Array("Cover Sheet", "Instructions")
Application.ScreenUpdating = False
With Worksheets("Cover Sheet")
.Unprotect Password:="cbs"
If ThisWorkbook.Name = "Bus Operator Cash Reconciliation Template1 updated3 .xls" Then
For Each Sht In ThisWorkbook.Worksheets
If IsError(Application.Match(Sht.Name, SheetsArray, 0)) Then Sht.Visible = False
Next Sht
Else
For Each Sht In ThisWorkbook.Worksheets
Sht.Visible = True
Next Sht
End If
.Protect Password:="cbs"
End With
Application.ScreenUpdating = True

End Sub




Sub Workbook_SelectionChange(ByVal Target As Excel.Range)
Static rr
Static cc

If cc <> "" Then
With Columns(cc).Interior
.ColorIndex = xlNone
End With
With Rows(rr).Interior
.ColorIndex = xlNone
End With
End If

r = Selection.Row
c = Selection.Column
rr = r
cc = c

With Columns(c).Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
With Rows(r).Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
End Sub





ON Sheet1


Option Explicit
' This code ensures that when an amount is placed in a certain column,
'it will force the user to select a reason. When a reason is selected
'without an amount, it will ensure a that the user enters an amount
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim i As Long
Dim LastRow As Long
Dim Prompt As String
Dim Title As String

If Target.Column <> 14 And Target.Column <> 15 _
And Target.Column <> 17 And Target.Column <> 23 _
And Target.Column <> 26 Then



'substantiated shortage
LastRow = Range("n" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
If Range("n" & i).Text <> "" And Range("q" & i).Text = "" Then
Prompt = "You must enter a reason for the substantiated difference in " & _
Range("q" & i).Address(False, False) & "."
Title = "Additional Information Required"
MsgBox Prompt, vbCritical, Title

GoTo ExitSub:
End If
Next i


'substantiated surplus
LastRow = Range("o" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
If Range("o" & i).Text <> "" And Range("q" & i).Text = "" Then
Prompt = "You must enter a reason for the substantiated difference in " & _
Range("q" & i).Address(False, False) & "."
Title = "Additional Information Required"
MsgBox Prompt, vbCritical, Title





GoTo ExitSub:
End If
Next i

'if there is a reason in q you need an amount in n & o
LastRow = Range("q" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
If Range("q" & i).Text <> "" And Range("n" & i).Text = "" And Range("o" & i).Text = "" Then
Prompt = "There must be a substantiated difference in Column N or O " & _
"for there to be a reason " & Range("Q" & i).Address(False, False) & "."
Title = "Additional Information Required"
MsgBox Prompt, vbCritical, Title



GoTo ExitSub:
End If
Next i

'download adjustment reason prompter
LastRow = Range("w" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
If Range("w" & i).Text <> "" And Range("z" & i).Text = "" Then
Prompt = "You must enter a download adjustment reason in " & _
Range("z" & i).Address(False, False) & "."
Title = "Additional Information Required"
MsgBox Prompt, vbCritical, Title
GoTo ExitSub:
End If
Next i
'download adjustment amount
LastRow = Range("z" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
If Range("z" & i).Text <> "" And Range("w" & i).Text = "" Then
Prompt = "For there to be a download adjustment reason, " & _
"there must be corresponding download adjustments to total a value in " & _
Range("w" & i).Address(False, False) & "."
Title = "Additional Information Required"
MsgBox Prompt, vbCritical, Title

GoTo ExitSub:
End If
Next i


End If

ExitSub:

End Sub


Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
‘this simply highlights a column and row at
'the same time in that particular sheet
Static rr
Static cc

If cc <> "" Then
With Columns(cc).Interior
.ColorIndex = xlNone
End With
With Rows(rr).Interior
.ColorIndex = xlNone
End With
End If

r = Selection.Row
c = Selection.Column
rr = r
cc = c

With Columns(c).Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
With Rows(r).Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
End Sub








Right now the above code doesn’t work.. how do I combine the Worksheet_SelectionChange(ByVal Target As Excel.Range) correctly to make it work… I pretty much got this code from this site and talored this for my purposes…

Anyhelp would be appreciated..

Thankyou

[johnske]

Please use VBA tags when posting code...

A major problem would be that there is no Workbook_SelectionChange event, i.e. Sub Workbook_SelectionChange(ByVal Target As Excel.Range) will never get triggered.

[Aussiebear]

Hmmm.... left hanging in the breeze on this one John. Care to elaborate a little more please?

[Bob Phillips]

As he says, there is no such event, it is Workbook_SheetSelectionChange, so the code given cannot possibly work.