vba if both active cells are in column 4

[hajiali]

Hello all needing to determine if both active cells are in column 4, only 2 cells will be selected and selected cell are not continuous so user can hold "CTRL" key to select them.

i currently have

If ActiveCell.Column = 4 Then

but if one of them is selected is in column 4 it will run the code.

any help is greatly appreciated.

Thanks,

 

[jasonb75]

ActiveCell is not the same as Selection, you can only have one ActiveCell at any time.

This will identify if any of the selected cells are in column D regardless of whether or not that cell is active.

If Not Intersect(Selection, Range("D:D")) Is Nothing Then

 

[hajiali]

using that still allows users to select cell from any column as long as one is in column D the macro runs. Here is what i have maybe this will help understand better

End Sub
Sub Swap()
If Not Intersect(Selection, Range("D:D")) Is Nothing Then
    If Selection.Count <> 2 Then
         MsgBox "Select 2 cells (only) to swap."
         Exit Sub
    End If
    Set trange = Selection
    If trange.Areas.Count = 2 Then
         Temp1 = trange.Areas(2)
         Temp2 = trange.Areas(2).Offset(0, -1)
         Temp3 = trange.Areas(2).Offset(0, 1)
         Temp4 = trange.Areas(2).Offset(0, 2)
         Temp5 = trange.Areas(2).Offset(0, 3)
         trange.Areas(2) = trange.Areas(1)
         trange.Areas(2).Offset(0, -1) = trange.Areas(1).Offset(0, -1)
         trange.Areas(2).Offset(0, 1) = trange.Areas(1).Offset(0, 1)
         trange.Areas(2).Offset(0, 2) = trange.Areas(1).Offset(0, 2)
         trange.Areas(2).Offset(0, 3) = trange.Areas(1).Offset(0, 3)
         trange.Areas(1) = Temp1
         trange.Areas(1).Offset(0, -1) = Temp2
         trange.Areas(1).Offset(0, 1) = Temp3
         trange.Areas(1).Offset(0, 2) = Temp4
         trange.Areas(1).Offset(0, 3) = Temp5
    Else
         Temp = trange(1)
         trange(1) = trange(2)
         trange(2) = Temp
    End If
    Else
    MsgBox "TO SWAP VALUES ONLY SELECT VAUELS IN COLUMN D"
   End If
End Sub

I need the macro to not to run unless both selected cells are from D otherwise prompt MsgBox "TO SWAP VALUES ONLY SELECT VAUELS IN COLUMN D"

 

[Akuini]

To check if selection is only in col D, try:

If Not Intersect(Selection, Range("D:D")) Is Nothing Then
    If Union(Selection, Range("D:D")).Address = Range("D:D").Address Then
        Debug.Print "YES"
    Else
        Debug.Print "NO"
    End If
End If