If ActiveCell.Validation.Formula1 Then adjust row height

[ABabeNChrist]

I am currently using this code below to adjust row height of merged cells
The first part looks for a name range

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Const sRange1 = "Ground"

    Dim oCell As Range

    If Not Intersect(Target, Range(sRange1)) Is Nothing Then
        For Each oCell In Intersect(Target, Range(sRange1))
            AFMCRH oCell
        Next oCell
    End If
End Sub

If target range is selected then this code from a module will run to adjust row height

Code: Select all

Sub AFMCRH(rng As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If rng.MergeCells Then
        Application.ScreenUpdating = False
        With rng.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = .Cells(1).ColumnWidth
                For Each CurrCell In rng.MergeArea
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next CurrCell
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = PossNewRowHeight
            End If
        End With
        Application.ScreenUpdating = True
    End If
End Sub

Is it possible to run AFMCRH if target cell has a data validation drop down?
If ActiveCell.Validation.Formula1 Then

[Rudi]

Try something like this...
Please note this is untested.

Code: Select all

Dim X As Variant
On Error Resume Next
X = Rng.Validation.Type
On Error GoTo 0
If IsEmpty(X) Then
    'Do nothing
Else
    'Code goes here...
End If
End Sub

[HansV]

Rudi's code only tests whether a cell has validation, not whether it has a validation dropdown. The following version tests for a dropdown:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oCell As Range
    On Error GoTo ExitHere
    If Not Intersect(Target, Me.UsedRange.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then
        For Each oCell In Intersect(Target, Me.UsedRange.SpecialCells(xlCellTypeAllValidation))
            If oCell.Validation.Type = xlValidateList Then
                AFMCRH oCell
            End If
        Next oCell
    End If
ExitHere:
End Sub

[ABabeNChrist]

Thank you Rudi
And thank you Hans, the code you provided seems to work great