Unable to select multiple cells with CTRL key

[peterbatah]

Hello all.

I have this bit of code running in my worksheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'updateby Extendoffice 20160530
    On Error GoTo LZoom
    Dim xZoom As Long
    xZoom = 100
    If Target.Validation.Type = xlValidateList Then xZoom = 130
LZoom:
    ActiveWindow.Zoom = xZoom
End Sub

The only way that I can select multiple cells using the CTRL key is if I break the running VB code.

Any assistance would be greatly appreciated.

Thank you

Peter

 

[MrKowz]

Try the below. We can test the number of selected cells (Target.Count) to see if there is only one cell selected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    'updateby Extendoffice 20160530
        On Error GoTo LZoom
        Dim xZoom As Long
        xZoom = 100
        If Target.Validation.Type = xlValidateList Then xZoom = 130
LZoom:
        ActiveWindow.Zoom = xZoom
End If
End Sub

 

[peterbatah]

UPDATE: My apologies. I had opened the wrong file which still had my original code.

The code that you provided appears to have solved the issue. Much appreciated!

Thank you so much for the prompt reply MrKowz. I really appreciate it.

Unfortunately, I am experiencing the same issue after replacing my code with the code that you kindly provided.

Try the below. We can test the number of selected cells (Target.Count) to see if there is only one cell selected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    'updateby Extendoffice 20160530
        On Error GoTo LZoom
        Dim xZoom As Long
        xZoom = 100
        If Target.Validation.Type = xlValidateList Then xZoom = 130
LZoom:
        ActiveWindow.Zoom = xZoom
End If
End Sub

 

[MrKowz]

Are you receiving an error? What is/isn't happening? I tested the theory using the below code, and it only showed me the message box if I had one cell selected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    MsgBox "foo"
End If
End Sub

 

[peterbatah]

No error messages. I should have deleted this line from my last response: Unfortunately, I am experiencing the same issue after replacing my code with the code that you kindly provided.


I am now able to select multiple cells when the VB code is running.

 

[MrKowz]

No error messages. I should have deleted this line from my last response: Unfortunately, I am experiencing the same issue after replacing my code with the code that you kindly provided.


I am now able to select multiple cells when the VB code is running.

Great - thank you for the feedback. Have a good day!

 

[peterbatah]

Likewise. Sorry about the mix up. Peter

 

[shg]

When you change zoom, you kill Undo, so you might want to do it as infrequently as necessary.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim iDV           As XlDVType

  If Target.CountLarge = 1 Then
    On Error Resume Next
    iDV = Target.Validation.Type
    If iDV = 0 Then
      If ActiveWindow.Zoom <> 100 Then ActiveWindow.Zoom = 100
    Else
      If ActiveWindow.Zoom <> 130 Then ActiveWindow.Zoom = 130
    End If
  End If
End Sub