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
Best Answer
It works pretty well.