Share via

Need help with multiple ranges on syntax

Anonymous
2023-06-14T15:05:45+00:00

Hi All,

I saw the following code from Nothing Left to Lose.

The example range in the code given is "E2.F15". I need some help adding multiple ranges of cells. I have tried Me.Range("I407:J424,"B407:B424) But the code doesn't run properly. Would anyone be able to tell me the proper syntax for multiple ranges? I have 40+ ranges of cells I need to use this code for and I am really stuck because I have no idea what I am doing. I am just copying and pasting this gentleman's code I saw in someone else's post.

Thank you so much for your help.

'---

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Nothing Left to Lose - April 2018 and March 2021
 Dim Rng As Excel.Range
 Dim rCell As Excel.Range
 Set Rng = Me.Range("E2:F15").Cells '<<< ADJUST AS NEEDED

 If Application.Intersect(Target(1), Rng) Is Nothing Then
   Exit Sub
 Else
   Application.ScreenUpdating = False
   For Each rCell In Rng
   If IsEmpty(rCell) Then
      rCell.Font.Name = "Wingdings 2"
      rCell.VerticalAlignment = xlCenter
      rCell.HorizontalAlignment = xlCenter
      rCell.Interior.ColorIndex = xlColorIndexNone
      rCell.Value = "£"
      rCell.Font.Bold = False
      rCell.Font.Color = 0
    End If
    Next
 End If
'No controls used - faux checkboxes using "Wingdings 2" font.
'toggle Checkmarks
 With Target(1)
  If .Value = "£" Then
     .Value = "R"
     .Font.Bold = True
     .Font.Color = 0 'Black
     .Interior.Color = vbGreen
      If Not Application.Intersect(Target(1), Rng.Columns(1)) Is Nothing Then
         With Target(1).Offset(0, 1)
          .Value = "£"
          .Font.Bold = False
          .Font.Color = 0 'Black
          .Interior.ColorIndex = xlColorIndexNone
         End With
      Else
         With Target(1).Offset(0, -1)
          .Value = "£"
          .Font.Bold = False
          .Font.Color = 0
          .Interior.ColorIndex = xlColorIndexNone
         End With
      End If
  Else
     .Value = "£"
     .Font.Bold = False
     .Font.Color = 0
     .Interior.ColorIndex = xlColorIndexNone
  End If
 End With
 Application.ScreenUpdating = True
'Escape from edit mode
 Cancel = True
End Sub

'---

Nothing Left to Lose

https://1drv.ms/u/s!Au8Lyt79SOuhZw2MCH7_7MuLj04?e=sAwbHU

(free excel programs)

Microsoft 365 and Office | Excel | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments No comments

Answer accepted by question author

HansV 462.6K Reputation points
2023-06-14T20:12:37+00:00

This should work better. You can add more sections as needed.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Nothing Left to Lose - April 2018 and March 2021

    If Not Application.Intersect(Me.Range("I407:J424"), Target) Is Nothing Then
        'Escape from edit mode
        Cancel = True
        ProcessRange Target, Me.Range("I407:J424")
    End If

    If Not Application.Intersect(Me.Range("D407:E424"), Target) Is Nothing Then
        'Escape from edit mode
        Cancel = True
        ProcessRange Target, Me.Range("D407:E424")
    End If
End Sub

Private Sub ProcessRange(tgt As Range, rng As Range)
    Dim rCell As Range
    Application.ScreenUpdating = False
    
    For Each rCell In rng
        With rCell
            If .Value = "" Then
                .Font.Name = "Wingdings 2"
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = xlColorIndexNone
                rCell.Value = "£"
                .Font.Bold = False
            End If
        End With
    Next rCell

    'No controls used - faux checkboxes using "Wingdings 2" font.
    'toggle Checkmarks
    With tgt
        If .Value = "£" Then
            .Value = "R"
            .Font.Bold = True
            .Font.Color = 0 'Black
            .Interior.Color = vbGreen
            If Not Application.Intersect(tgt, rng.Columns(1)) Is Nothing Then
                With .Offset(0, 1)
                    .Value = "£"
                    .Font.Bold = False
                    .Interior.ColorIndex = xlColorIndexNone
                End With
            Else
                With .Offset(0, -1)
                    .Value = "£"
                    .Font.Bold = False
                    .Interior.ColorIndex = xlColorIndexNone
                End With
            End If
        Else
            .Value = "£"
            .Font.Bold = False
            .Interior.ColorIndex = xlColorIndexNone
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Was this answer helpful?

1 person found this answer helpful.
0 comments No comments

5 additional answers

Sort by: Most helpful
  1. Anonymous
    2023-06-14T15:34:22+00:00

    I need to add a ton of check boxes to a spreadsheet. I used the built in form check boxes it was lagging the spreadsheet to the point of being unusable. The check boxes do not have any function in the spreadsheet itself. It is just a check box for an inspector to check off. It does not need any code to alter any other cells.

    I looked up how to add checkmark boxes without excel lagging and crashing and that is the code that I found.

    Was this answer helpful?

    0 comments No comments
  2. Anonymous
    2023-06-14T15:28:39+00:00

    Thank you for answering Hans.

    What happens when I do that is the second set of range that I use, the checkbox doesn't function like the first set in the range. The first set allows me to check only one box, the second set in the range allows me to check both yes and no boxes and also places another character directly to the left of the cell of the Yes. It happens to only the ranges after the first one.

    This is what I have typed in:

    Set Rng = Me.Range("D407:E424,I407:J424").Cells

    Was this answer helpful?

    0 comments No comments
  3. HansV 462.6K Reputation points
    2023-06-14T15:23:21+00:00

    By the way, what are you trying to accomplish? The code as it is now makes little sense to me.

    Was this answer helpful?

    0 comments No comments
  4. HansV 462.6K Reputation points
    2023-06-14T15:16:55+00:00

    Use

    Me.Range("I407:J424,B407:B424")

    Was this answer helpful?

    0 comments No comments