2
votes

I have code to do 2 things: first of all it sorts items from data validation drop lists which is located in Sheet 2 with "," to desired range of cells located in Sheet 1. Also,if user selects the same item, it deletes it from selected cell.

The other option of code is when user selects the cells of dropdown lists(which is located in D2:F325 it should zoom in 100% to see the items on the lists(cause its font sizes are too small to see)

In the below code works almost perfectly. Because, it only zooms when i select a single cell from the desired range:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then GoTo exitHandler

    If Target.Address = Range("XYZ").Address Then
        ActiveWindow.Zoom = 100
        [A5000] = "zoomed"
        ElseIf [A5000] = "zoomed" Then
        'Otherwise set the zoom to original
        ActiveWindow.Zoom = 70
        [A5000].ClearContents
    End If

exitHandler:
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim strVal As String
    Dim i As Long
    Dim lCount As Long
    Dim Ar As Variant
    On Error Resume Next
    Dim lType As Long
    If Target.Count > 1 Then GoTo exitHandler

    lType = Target.Validation.Type
    If lType = 3 Then
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal

        If oldVal = "" Then
            'do nothing
        Else
            If newVal = "" Then
                'do nothing
            Else
                On Error Resume Next
                Ar = Split(oldVal, ", ")
                strVal = ""
                For i = LBound(Ar) To UBound(Ar)
                    Debug.Print strVal
                    Debug.Print CStr(Ar(i))
                    If newVal = CStr(Ar(i)) Then
                        'do not include this item
                        strVal = strVal
                        lCount = 1
                    Else
                        strVal = strVal & CStr(Ar(i)) & ", "
                    End If
                Next i
                If lCount > 0 Then
                    Target.Value = Left(strVal, Len(strVal) - 2)
                Else
                    Target.Value = strVal & newVal
                End If
            End If
        End If

    End If

exitHandler:
    Application.EnableEvents = True
End Sub

XYZ is the name of cell D2 cause i tried to named this range to select with this function but it did not work.

Finally, how Target.Address can select whole range D2:F325

1
you have this line at the begining of your code If Target.Count > 1 Then GoTo exitHandler , if you select more than 1 cell you exit your SubShai Rado

1 Answers

1
votes
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then GoTo exitHandler

 If Not Application.Intersect(Target, Range("D2:F325")) Is Nothing Then
   ActiveWindow.Zoom = 100
   [A5000] = "zoomed"
 ElseIf [A5000] = "zoomed" Then
 'Otherwise set the zoom to original
ActiveWindow.Zoom = 70
[A5000].ClearContents
End If

 exitHandler:
  Application.EnableEvents = True
End Sub

It works pretty well.