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:
[vba]
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
[/vba]
ON Sheet1
[vba]
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
[/vba]
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
Reply With Quote
