Solved: Offset Macro Needed...I think

[coliervile]

Good morning to everyone... :hi: In the following worksheet I have two macros that allows the user to use the double-click feature (both left click and right click of the mouse) in the cells that have a white background. The left double-click adds one to the cell's value and the right double-click subtracts one from the cell's value. In the macros if I use all of the various ranges in the worksheet to use the double-click feature the macro would be extremely long. I need, I think an Offset Macro, to streamline the two macros and make them more efficient. Thanks for your help.

Best regards,

Charlie
</IMG>

[Bob Phillips]

Hi Charlie,

Try something like this



Option Explicit

Const WS_RANGE As String = "C:C"
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:BY"

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

Dim mpStart As Range
Dim i As Long

Cancel = True

With Target

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) _
) 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
End With
'Cancel = True

End Sub

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

With Target

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) _
) 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)
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 = Me.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 = .Value
Exit For
End If
Next i
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[coliervile]

Good day to you Bob hope things are going well for you? Thanks for you coding it worked just like I wanted. Another victory for you and VBAX..............
:bigdance2
Best regards,

Charllie

[mdmackillop]

Hi Charlie,
Remember to mark threads Solved