PDA

View Full Version : Solved: Adding More Cell Ranges to BeforeDoubleClick and BeforeRightClick Macro



coliervile
05-13-2008, 03:37 PM
The present coding allows the user to Left Double-Click (the cell in white) to add one to the current cell value and Right Double-Click (the cells colored white) to subtract one from the cells value. I need to add more cell ranges (the cells hightlighted in YELOW) to the current BeforeDoubleClick and BeforeRightClick macro. The coding in the following worksheel was provided by "XLD"....thanks Bob.

Best regards,

Charlie

JimmyTheHand
05-14-2008, 12:30 AM
Charlie,

Try this code. It's quite different from what you uploaded, but I think it will suit your needs.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ValidTarget(Target) Then
If IsNumeric(Target.Value) Then Target.Value = Target.Value + 1
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If ValidTarget(Target) Then
If IsNumeric(Target.Value) Then Target.Value = Target.Value - 1
End If
End Sub

Function ValidTarget(Tgt As Range) As Boolean
Dim T1 As Range, T2 As Range

ValidTarget = False

Set T1 = Range("G10:G18, N10:N11, N13:N15, J18:K18")
Set T2 = Cells((Tgt.Row - 10) Mod 9 + 10, (Tgt.Column - 6) Mod 9 + 6)
If (Not Intersect(T1, T2) Is Nothing) And _
(Not Intersect(Tgt, Range("F10:CH117")) Is Nothing) Then ValidTarget = True

Set T1 = Range("J5, J6, J119, I126:N134")
Set T2 = Cells(Tgt.Row, (Tgt.Column - 6) Mod 9 + 6)
If (Not Intersect(T1, T2) Is Nothing) And (Tgt.Row > 5) And (Tgt.Column < 87) Then ValidTarget = True

If Not Intersect(Range("Q7, T7, AR7, AU7"), Tgt) Is Nothing Then ValidTarget = True

End Function

Private Sub Worksheet_Change was left unchanged.

HTH
Jimmy

coliervile
05-14-2008, 01:37 AM
Thanks JimmyTheHand for youe time and coding. It did everything with the exception of row 5. Starting at J5 when these cells are double-clicked nothing happens. Your coding does include, I believe, this range, but doesn't put a one in the cell???

Best regards,

Charlie

coliervile
05-14-2008, 01:37 AM
Thanks JimmyTheHand for youe time and coding. It did everything with the exception of row 5. Starting at J5 when these cells are double-clicked nothing happens. Your coding does include, I believe, this range, but doesn't put a one in the cell???

Best regards,

Charlie

Bob Phillips
05-14-2008, 01:46 AM
Function ValidTarget(Tgt As Range) As Boolean
Dim T1 As Range, T2 As Range

ValidTarget = False

Set T1 = Range("G10:G18, N10:N11, N13:N15, J18:K18")
Set T2 = Cells((Tgt.Row - 10) Mod 9 + 10, (Tgt.Column - 6) Mod 9 + 6)
If (Not Intersect(T1, T2) Is Nothing) And _
(Not Intersect(Tgt, Range("F10:CH117")) Is Nothing) Then ValidTarget = True

Set T1 = Range("J5, J6, J119, I126:N134")
Set T2 = Cells(Tgt.Row, (Tgt.Column - 6) Mod 9 + 6)
If (Not Intersect(T1, T2) Is Nothing) And (Tgt.Column > 5) And (Tgt.Column < 87) Then ValidTarget = True

If Not Intersect(Range("Q7, T7, AR7, AU7"), Tgt) Is Nothing Then ValidTarget = True

End Function

JimmyTheHand
05-14-2008, 01:50 AM
My mistake, sorry.

If (Not Intersect(T1, T2) Is Nothing) And (Tgt.Row > 5) And (Tgt.Column < 87) Then ValidTarget = True
must be changed into
If (Not Intersect(T1, T2) Is Nothing) And (Tgt.Column > 5) And (Tgt.Column < 87) Then ValidTarget = True
Also, the worksheet events should be modified (changes are highlighted):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ValidTarget(Target) Then
Cancel = True
If IsNumeric(Target.Value) Then Target.Value = Target.Value + 1
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If ValidTarget(Target) Then
Cancel = True
If IsNumeric(Target.Value) Then Target.Value = Target.Value - 1
End If
End Sub
Jimmy

coliervile
05-14-2008, 01:54 AM
Good day to you Sir. How are thing going for you Bob? Your coding for this issue worked and I'll mark it close.

Bob second note: I came across a glitch in some coding you helped me with. I'll have to wait untill later to open a new thread to address it.

Best regards,

Charlie

Bob Phillips
05-14-2008, 01:58 AM
BTW, this is the changes to the original code



Option Explicit

Const WS_RANGE As String = "C:C"
Const WS_RANGE2 As String = "Q7,T7,AR7,AU7"
Const WS_RANGE_ROW As String = "10:117"
Const WS_RANGE_COL1 As String = "G:CA"
Const WS_RANGE_ROW2 As String = "10:117"
Const WS_RANGE_COL2 As String = "N:CH"
Const WS_RANGE_ROW3 As String = "5:6"
Const WS_RANGE_ROW4 As String = "119:119"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim mpStart As Range
Dim i As Long

Cancel = True

With Target

If IsTarget(Target) Then

If IsNumeric(.Value) Then

.Value = .Value + 1
End If
ElseIf Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

If .Row > 10 And .Row < 118 And .Row Mod 9 <> 1 Then

Set mpStart = Range("F" & (.Row \ 10 + 1) * 9)
End If

For i = 2 To 9

If mpStart.Offset(0, (i - 1) * 9 + 8).Value = "" And _
mpStart.Offset(0, (i - 1) * 9 - 1).Value = .Cells(1, 1).Value Then

mpStart.Offset(0, (i - 1) * 9 + 8).Value = Target.Value
Exit For
End If
Next i
End If
'Cancel = True
End With
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

With Target

If IsTarget(Target) Then

If IsNumeric(.Value) Then

.Value = .Value - 1
End If
End If
End With
'Cancel = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:C"
Dim mpStart As Range
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

If .Row > 10 And .Row < 118 And .Row Mod 9 <> 1 Then

Set mpStart = Range("F" & (.Row \ 10 + 1) * 9)
End If

For i = 1 To 9

If mpStart.Offset(0, (i - 1) * 9 + 8).Value = "" Then

mpStart.Offset(0, (i - 1) * 9 + 8).Value = Target.Value
Exit For
End If
Next i
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Function IsTarget(ByVal Target As Range) As Boolean

If (Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL1)) Is Nothing And _
Target.Column Mod 9 = 7) _
) Or _
_
((Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or _
Target.Row Mod 9 = 3 Or _
Target.Row Mod 9 = 7 Or _
Target.Row Mod 9 = 8) _
) And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL2)) Is Nothing And _
Target.Column Mod 9 = 5) _
) Or _
_
(Not Intersect(Target, Me.Range(WS_RANGE_ROW3)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
_
(Not Intersect(Target, Me.Range(WS_RANGE_ROW4)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
_
Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then

IsTarget = True
End If
End Function

coliervile
05-14-2008, 01:59 AM
Thanks JimmyTheHand I'll have to take a look later, getting ready to head out, at your suggestion.

Best regards,

Charlie

coliervile
05-14-2008, 02:01 AM
Thanks Bob and I'll open that other thread later today.

Best regards,

Charlie

coliervile
05-14-2008, 02:09 AM
Bob would I get compile errors with the tick mark on the left in red?

Best regards,

Charlie

Private Function ValidTarget(ByVal Target As Range) As Boolean

If (Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL1)) Is Nothing And _
Target.Column Mod 9 = 7) _
) Or _
_
((Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or _
Target.Row Mod 9 = 3 Or _
Target.Row Mod 9 = 7 Or _
Target.Row Mod 9 = 8) _
) And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL2)) Is Nothing And _
Target.Column Mod 9 = 5) _
) Or _
_
(Not Intersect(Target, Me.Range(WS_RANGE_ROW3)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
_
(Not Intersect(Target, Me.Range(WS_RANGE_ROW4)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
_
Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then

ValidTarget = True
End If
End Function

Bob Phillips
05-14-2008, 03:34 AM
Shouldn't do, that is the only way you can include what is effectively a break line in an If statement. I do it for readability.

coliervile
05-14-2008, 05:20 AM
Bob I get a Compile Error: Syntax Error at this ppoint in the coding If (Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL1)) Is Nothing And _
Target.Column Mod 9 = 7) _
) Or _
_

I'm using Excel 2003... if it makes a difference.

Best regards,

Charlie

coliervile
05-14-2008, 05:23 AM
Here's how the code actually shows up:

Private Function IsTarget(ByVal Target As Range) As Boolean

If (Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL1)) Is Nothing And _
Target.Column Mod 9 = 7) _
) Or _
_
((Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or _
Target.Row Mod 9 = 3 Or _
Target.Row Mod 9 = 7 Or _
Target.Row Mod 9 = 8) _
) And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL2)) Is Nothing And _
Target.Column Mod 9 = 5) _
) Or _
_
(Not Intersect(Target, Me.Range(WS_RANGE_ROW3)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
_
(Not Intersect(Target, Me.Range(WS_RANGE_ROW4)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
_
Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then

IsTarget = True
End If
End Function

Best regards,

Charlie

JimmyTheHand
05-14-2008, 06:04 AM
Put one SPACE before all those underlines at the left end.

Jimmy

coliervile
05-14-2008, 07:33 AM
Thanks JimmyTheHand for your suggestion and it did work. In the coding that "xld provided some of the cells didn't work??? I've included the worksheet with "xld" coding and put arrows to all of cells that didn't work with the right and left click.

Best regards,

Charlie

Bob Phillips
05-14-2008, 08:02 AM
No attachment.

Bob Phillips
05-14-2008, 08:05 AM
Put one SPACE before all those underlines at the left end.

Jimmy

Sorry about that. When creating the code the indents align it and then VBA automatically positions it.

coliervile
05-14-2008, 09:23 AM
Let me try to download the file once more....

Best regards,

Charlie

coliervile
05-18-2008, 02:41 AM
I would like to add all of the cells coloured in yellow on the attached worksheet to the left and right double-click funtion of adding and subtracting one from the cells value.

coliervile
05-18-2008, 05:24 AM
I got the cell coloured white added to the double-click function, but when I try to add more cell ranges I get an error message: "To many line contiuations". I don't know how to get around this???

Bob Phillips
05-18-2008, 05:39 AM
Try the other method of defining the target cells.

coliervile
05-18-2008, 05:43 AM
Are you referring to this?


Dim aryRows As Variant
Dim aryCols As Variant
Dim ActiveCell As Boolean

aryRows = Array(12, 21, 30, 39, 48, 57, 66, 75, 84, 93, 102, 111)
aryCols = Array(10, 19, 28, 37, 46, 55, 64, 73, 82)

ActiveCell = Not (IsError(Application.Match(Target.Row, aryRows, 0))) And _
Not (IsError(Application.Match(Target.Column, aryCols, 0)))

Bob Phillips
05-18-2008, 05:53 AM
Yes I am. I haven't looked at this problem, but I guess it is again the highly structured dataset like before, so you will be looking for consistent column/row offsets, which that technique supprts well.

coliervile
05-18-2008, 05:57 AM
I don't believe they're the same. This one takes into account a wide range of cells across the worksheet to use the double-click function.

Bob Phillips
05-18-2008, 06:49 AM
Just remove the break continuations.

Bob Phillips
05-18-2008, 06:58 AM
You can even merge lines



Private Function IsTarget(ByVal Target As Range) As Boolean
Dim aryRows As Variant
Dim aryCols As Variant

If (Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL1)) Is Nothing And _
Target.Column Mod 9 = 7)) Or _
((Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or Target.Row Mod 9 = 3 Or Target.Row Mod 9 = 7 Or Target.Row Mod 9 = 8)) And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL2)) Is Nothing And _
Target.Column Mod 9 = 5)) Or _
(Not Intersect(Target, Me.Range(WS_RANGE_ROW3)) Is Nothing And _
Target.Column Mod 9 = 1) Or _
(Not Intersect(Target, Me.Range(WS_RANGE_COL3)) Is Nothing And _
Target.Column Mod 9 = 2) Or _
(Not Intersect(Target, Me.Range(WS_RANGE_ROW4)) Is Nothing And _
Target.Column Mod 9 = 2) Or _
Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then

IsTarget = True
End If
End Function


This should give you some expansion room.

coliervile
05-18-2008, 07:35 AM
I've gotten everything, but can't seem to get the very bottom columns and rows. I'm not getting any errors, but the double-click doesn't add or subtract one from the cells (coloured in YELLOW) values? The rows and columns I've added are columns L:N and rows 126:134. There seems that there would be one addition to include all of the YELLOW cells in one feel swoop.

coliervile
05-18-2008, 08:37 AM
I just realized that with these ranges, highlighted in red, I may need an offset so that the whole row and column doesn't have the double-click function. An offset is well beyound my capabilities/limiits. I would greatly appreciate someone help with this offset. There is already one offset funtion for the double-click feature.

Option Explicit

Const WS_RANGE As String = "C:C"
Const WS_RANGE2 As String = "Q7,T7,AR7,AU7"
Const WS_RANGE_ROW As String = "10:117"
Const WS_RANGE_COL1 As String = "G:CA"
Const WS_RANGE_ROW2 As String = "10:117"
Const WS_RANGE_COL2 As String = "N:CH"
Const WS_RANGE_ROW3 As String = "5:6"
Const WS_RANGE_COL3 As String = "K:CE"
Const WS_RANGE_ROW4 As String = "18:117"
Const WS_RANGE_COL4 As String = "J:CD"
Const WS_RANGE_ROW5 As String = "119:119"
Const WS_RANGE_COL5 As String = "L:CH"
Const WS_RANGE_ROW6 As String = "126:134"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim mpStart As Range
Dim i As Long

Cancel = True

With Target

If IsTarget(Target) Then

If IsNumeric(.Value) Then

.Value = .Value + 1
End If
ElseIf Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

If .Row > 10 And .Row < 118 And .Row Mod 9 <> 1 Then

Set mpStart = Range("F" & (.Row \ 9 + 1) * 9)
End If

For i = 1 To 9

If mpStart.Offset(0, (i - 1) * 9 + 8).Value = "" And _
mpStart.Offset(0, (i - 1) * 9 - 1).Value = .Cells(1, 1).Value Then

mpStart.Offset(0, (i - 1) * 9 + 8).Value = Target.Value
Exit For
End If
Next i
End If
'Cancel = True
End With
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

With Target

If IsTarget(Target) Then

If IsNumeric(.Value) Then

.Value = .Value - 1
End If
End If
End With
'Cancel = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:C"
Dim mpStart As Range
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

If .Row > 10 And .Row < 118 And .Row Mod 9 <> 1 Then

Set mpStart = Range("F" & (.Row \ 9 + 1) * 9)
End If

For i = 1 To 9

If mpStart.Offset(0, (i - 1) * 9 + 8).Value = "" Then

mpStart.Offset(0, (i - 1) * 9 + 8).Value = Target.Value
Exit For
End If
Next i
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Function IsTarget(ByVal Target As Range) As Boolean

If (Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL1)) Is Nothing And _
Target.Column Mod 9 = 7)) Or _
((Not Intersect(Target, Me.Range(WS_RANGE_ROW)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or Target.Row Mod 9 = 3 Or Target.Row Mod 9 = 7 Or Target.Row Mod 9 = 8)) And _
(Not Intersect(Target, Me.Range(WS_RANGE_COL2)) Is Nothing And Target.Column Mod 9 = 5)) Or _
(Not Intersect(Target, Me.Range(WS_RANGE_ROW3)) Is Nothing And _
Target.Column Mod 9 = 1) Or (Not Intersect(Target, Me.Range(WS_RANGE_COL3)) Is Nothing And _
Target.Column Mod 9 = 2) Or (Not Intersect(Target, Me.Range(WS_RANGE_ROW4)) Is Nothing And _
Target.Column Mod 9 = 1) Or (Not Intersect(Target, Me.Range(WS_RANGE_COL4)) Is Nothing And _
Target.Column Mod 9 = 1) Or (Not Intersect(Target, Me.Range(WS_RANGE_ROW5)) Is Nothing And _
Target.Column Mod 9 = 2) Or Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then

IsTarget = True
End If
End Function

Bob Phillips
05-18-2008, 08:43 AM
I think you mean limits not offsets. What are the limits?

Bob Phillips
05-18-2008, 08:49 AM
Also, aren't some of these ranges overlapping (I must admit to being lost as to what is actually being checked re the spreadsheet, so you will have to guide). For instance, isn't RANGE_ROW4 only true if also RANGE_COL3, and so on?

coliervile
05-18-2008, 09:04 AM
Please take a look at the worksheet and hopefully it explains it well enough. I also don't want to lose those cells already part of the double-click using the left and right mouse buttons. Thanks!

coliervile
05-18-2008, 09:30 AM
I've attached a worksheet that I've coloured with all of the cells that I want the double-click funtion to work in. The areas with the same color should have the same limits??? The gray shadied area is where I don't want the double-click function in. Please take a look at the worksheet.

Bob Phillips
05-18-2008, 10:00 AM
Try this



Private Function IsTarget(ByVal Target As Range) As Boolean
Const WS_RANGE1_ROWS As String = "10:117"
Const WS_RANGE1_COLS As String = "G:CA"
Const WS_RANGE2_ROWS As String = "10:117"
Const WS_RANGE2_COLS As String = "N:CH"
Const WS_RANGE3_ROWS As String = "5:6"
Const WS_RANGE4_COLS As String = "K:CE"
Const WS_RANGE4_ROWS As String = "18:117"
Const WS_RANGE5_COLS As String = "J:CD"
Const WS_RANGE5_ROWS As String = "119:119"
Const WS_RANGE6_COLS As String = "L:CH"
Const WS_RANGE6_ROWS As String = "126:134"
Dim aryRows As Variant
Dim aryCols As Variant

If (Not Intersect(Target, Me.Range(WS_RANGE1_ROWS)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE1_COLS)) Is Nothing And _
Target.Column Mod 9 = 7)) Then

IsTarget = True
End If

If ((Not Intersect(Target, Me.Range(WS_RANGE2_ROWS)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or Target.Row Mod 9 = 3 Or Target.Row Mod 9 = 7 Or Target.Row Mod 9 = 8)) And _
(Not Intersect(Target, Me.Range(WS_RANGE2_COLS)) Is Nothing And _
Target.Column Mod 9 = 5)) Then

IsTarget = True
End If

If (Not Intersect(Target, Me.Range(WS_RANGE3_ROWS)) Is Nothing And _
Target.Column Mod 9 = 1) Then

IsTarget = True
End If

If Not Intersect(Target, Me.Range(WS_RANGE4_COLS)) Is Nothing And _
Target.Column Mod 9 = 2 And _
Not Intersect(Target, Me.Range(WS_RANGE4_ROWS)) Is Nothing And _
Target.Row Mod 9 = 2 Then

IsTarget = True
End If

If Not Intersect(Target, Me.Range(WS_RANGE5_COLS)) Is Nothing And _
Target.Column Mod 9 = 1 And _
Not Intersect(Target, Me.Range(WS_RANGE5_ROWS)) Is Nothing Then

IsTarget = True
End If

If Not Intersect(Target, Me.Range(WS_RANGE6_COLS)) Is Nothing And _
(Target.Column Mod 9 = 3 Or Target.Column Mod 9 = 4 Or Target.Column Mod 9 = 5) And _
Not Intersect(Target, Me.Range(WS_RANGE6_ROWS)) Is Nothing Then

IsTarget = True
End If
End Function

coliervile
05-18-2008, 10:17 AM
Bob everything seems to work with the exception of Q7,T7,AR7,AU7 and all of the orange coloured cells. I've attached the worksheet.

Bob Phillips
05-18-2008, 02:15 PM
Private Function IsTarget(ByVal Target As Range) As Boolean
Const WS_RANGE_Cells As String = "Q7,T7,AR7,AU7"
Const WS_RANGE1_ROWS As String = "10:117"
Const WS_RANGE1_COLS As String = "G:CA"
Const WS_RANGE2_ROWS As String = "10:117"
Const WS_RANGE2_COLS As String = "N:CH"
Const WS_RANGE3_ROWS As String = "5:6"
Const WS_RANGE4_COLS As String = "K:CE"
Const WS_RANGE4_ROWS As String = "18:117"
Const WS_RANGE5_COLS As String = "J:CD"
Const WS_RANGE5_ROWS As String = "119:119"
Const WS_RANGE6_COLS As String = "L:CH"
Const WS_RANGE6_ROWS As String = "126:134"

If Not Intersect(Target, Me.Range(WS_RANGE_CELLS)) Is Nothing Then

IsTarget = True
End If

If (Not Intersect(Target, Me.Range(WS_RANGE1_ROWS)) Is Nothing And _
(Not Intersect(Target, Me.Range(WS_RANGE1_COLS)) Is Nothing And _
Target.Column Mod 9 = 7)) Then

IsTarget = True
End If

If ((Not Intersect(Target, Me.Range(WS_RANGE2_ROWS)) Is Nothing And _
Not (Target.Row Mod 9 = 0 Or Target.Row Mod 9 = 3 Or Target.Row Mod 9 = 7 Or Target.Row Mod 9 = 8)) And _
(Not Intersect(Target, Me.Range(WS_RANGE2_COLS)) Is Nothing And _
Target.Column Mod 9 = 5)) Then

IsTarget = True
End If

If (Not Intersect(Target, Me.Range(WS_RANGE3_ROWS)) Is Nothing And _
Target.Column Mod 9 = 1) Then

IsTarget = True
End If

If Not Intersect(Target, Me.Range(WS_RANGE4_COLS)) Is Nothing And _
Target.Column Mod 9 = 2 And _
Not Intersect(Target, Me.Range(WS_RANGE4_ROWS)) Is Nothing And _
Target.Row Mod 9 = 0 Then

IsTarget = True
End If

If Not Intersect(Target, Me.Range(WS_RANGE5_COLS)) Is Nothing And _
Target.Column Mod 9 = 1 And _
Not Intersect(Target, Me.Range(WS_RANGE5_ROWS)) Is Nothing Then

IsTarget = True
End If

If Not Intersect(Target, Me.Range(WS_RANGE6_COLS)) Is Nothing And _
(Target.Column Mod 9 = 3 Or Target.Column Mod 9 = 4 Or Target.Column Mod 9 = 5) And _
Not Intersect(Target, Me.Range(WS_RANGE6_ROWS)) Is Nothing Then

IsTarget = True
End If
End Function

coliervile
05-18-2008, 02:47 PM
Thanks Bob I'm glad that's done and over with it was frustrating me. I had put something similar to this: Const WS_RANGE_CELLS AsString = "Q7,T7,AR7,AU7" and

If Not Intersect(Target, Me.Range(WS_RANGE_CELLS)) Is Nothing Then

IsTarget = True
End If

but I had left out "CELLS".

I see that you replaced the 2 with a 0 here too:

If Not Intersect(Target, Me.Range(WS_RANGE4_COLS)) Is Nothing And _
Target.Column Mod 9 = 2 And _
Not Intersect(Target, Me.Range(WS_RANGE4_ROWS)) Is Nothing And _
Target.Row Mod 9 = 0 Then

Thanks for you help Sir and have a great evening.

Bob Phillips
05-18-2008, 03:28 PM
Yeah, I wasn't sure whether you had moved the target rows (re the 2/0), :smile: or whethre I had mis-transcribed, copy one line down and dot replacing the 2 with 0.

I don't know if you realised, but I renamed the constants to match the row/column pairs, and moved them into the IsTarget procedure; so most of those at the head of the module are now redundant.

coliervile
05-18-2008, 05:28 PM
Yes I did see the redundant row/column pairs and deleted them or those that were suppose to be deleted. Thanks again for your help.