Compile error / prosedure too large

[blaksnm]

Hi
I have a table with 7 x 5 rows, 6-10,12-16, 18-22, 24-28, 30-34, 36-40 and 42-46 (Total 35 rows)
For each row this procedure is made (example below is to row 46):
The procedure works fine on 34 rows (random pick), but not when I hardcode the 35th...
I am searching this forum for some guiding out of this problem - can anybody help me?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 2/26/2020 10:33:36 PM EST
'ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = False

If Not Intersect(Target, Range("B46")) Is Nothing Then
Cancel = True
Range("B46").Value = Range("B4").Value + 1
Range("C46").Select
End If

If Not Intersect(Target, Range("C46")) Is Nothing Then
Cancel = True
Range("B46:B46").ClearContents
Range("B46").Value = Range("B4").Value + 1
Range("C46").Copy
Sheets("Fordeling").Range("FordelingKodeSubArea") = Sheets("Reg").Range("C46") 'value'PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ArbeidsArtListe
Range("E46").Value = Sheets("Fordeling").Range("FordelingKopiStart").Value
Range("E46").Select
Range("J46").Value = "Ferdig"
Range("L46").Value = Time
End If

If Not Intersect(Target, Range("J46")) Is Nothing Then
Cancel = True
Range("J46").Value = "Ferdig"
Range("M46").Value = Time
Range("M46").Select

End If

If Not Intersect(Target, Range("K46")) Is Nothing Then
Cancel = True
KjøreListeReg
End If

If Not Intersect(Target, Range("L46")) Is Nothing Then
Cancel = True
ActiveCell.Value = Time
Range("L46").Select
End If

If Not Intersect(Target, Range("M46")) Is Nothing Then
Cancel = True
ActiveCell.Value = Time
Range("M46").Select
End If
Application.ScreenUpdating = True
End Sub

 

[blaksnm]

Hi
I have a table with 7 x 5 rows, 6-10,12-16, 18-22, 24-28, 30-34, 36-40 and 42-46 (Total 35 rows)
For each row this procedure is made (example below is to row 46):
The procedure works fine on 34 rows (random pick), but not when I hardcode the 35th...
I am searching this forum for some guiding out of this problem - can anybody help me?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 2/26/2020 10:33:36 PM EST
'ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = False

If Not Intersect(Target, Range("B46")) Is Nothing Then
Cancel = True
Range("B46").Value = Range("B4").Value + 1
Range("C46").Select
End If

If Not Intersect(Target, Range("C46")) Is Nothing Then
Cancel = True
Range("B46:B46").ClearContents
Range("B46").Value = Range("B4").Value + 1
Range("C46").Copy
Sheets("Fordeling").Range("FordelingKodeSubArea") = Sheets("Reg").Range("C46") 'value'PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ArbeidsArtListe
Range("E46").Value = Sheets("Fordeling").Range("FordelingKopiStart").Value
Range("E46").Select
Range("J46").Value = "Ferdig"
Range("L46").Value = Time
End If

If Not Intersect(Target, Range("J46")) Is Nothing Then
Cancel = True
Range("J46").Value = "Ferdig"
Range("M46").Value = Time
Range("M46").Select

End If

If Not Intersect(Target, Range("K46")) Is Nothing Then
Cancel = True
KjøreListeReg
End If

If Not Intersect(Target, Range("L46")) Is Nothing Then
Cancel = True
ActiveCell.Value = Time
Range("L46").Select
End If

If Not Intersect(Target, Range("M46")) Is Nothing Then
Cancel = True
ActiveCell.Value = Time
Range("M46").Select
End If
Application.ScreenUpdating = True
End Sub

Can I simplyfy the procedure by change the row indicator with a variable (=active row)?

 

[JLGWhiz]

See if this modified version works for you.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified 12/16/2020
'ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = False
If Not Intersect(Target, Range("B46")) Is Nothing Then
    Cancel = True
    Range("B46").Value = Range("B4").Value + 1
    Range("B46:B46").ClearContents
    Range("B46").Value = Range("B4").Value + 1
    Range("C46").Copy
    Sheets("Fordeling").Range("FordelingKodeSubArea") = Sheets("Reg").Range("C46") 'value'PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ArbeidsArtListe
    Range("E46").Value = Sheets("Fordeling").Range("FordelingKopiStart").Value
    Range("E46").Select
    Range("J46").Value = "Ferdig"
    Range("L46").Value = Time
    Range("J46").Value = "Ferdig"
    Range("M46").Value = Time
    KjøreListeReg
    ActiveCell.Value = Time
    ActiveCell.Value = Time
    Range("M46").Select
End If
Application.ScreenUpdating = True
End Sub

 

[blaksnm]

Thanks for trying, but this is procedure does not do the actions correctly. Sorry

 

[JLGWhiz]

Thanks for trying, but this is procedure does not do the actions correctly. Sorry

Yes, I see that my failing eyesight has once again betrayed me. After closer inspection, I see that when certain condititions are true, the code could call two other procedures. Have you looked at them to determine if they might be the souce of the problem?

 

[Fluff]

Maybe something like

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = False
Dim Rw As Long
Rw = Target.Row

If Not Intersect(Target, Range("B6:B46")) Is Nothing Then
Cancel = True
Range("B" & Rw).Value = Range("B4").Value + 1
Range("C" & Rw).Select
End If

 

[blaksnm]

Thanks again
I'll try this one in a couple of days

 

[blaksnm]

Brilliant!!
This seems to make the trick
Thanks a lot

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[blaksnm]

Rw = Target.Row

One more question: What do I do to copy a value from (Range("M" & Rw) to Range("L"& row +1)?
Expression Range("L" & Rw + 1).Value = .... does not work