cell activate show pop up "box" with a range of cell values

[zrx1200]

I would like to have a macro fire automatic when any cell in a column is highlighted. this would then bring a range of 10 cells of this row into a pop up to show values of theses cells.

Any direction would be much appreciated.

 

[JLGWhiz]

I would like to have a macro fire automatic when any cell in a column is highlighted. this would then bring a range of 10 cells of this row into a pop up to show values of theses cells.

Any direction would be much appreciated.

Copy this code to your worksheet code module.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    For i = 2 To 11
        msg = msg & Cells(Target.Row, i).Value & ", "
    Next
    MsgBox msg
End If
End Sub

 

[zrx1200]

Copy this code to your worksheet code module.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    For i = 2 To 11
        msg = msg & Cells(Target.Row, i).Value & ", "
    Next
    MsgBox msg
End If
End Sub

Thanks for reply! Here is my revised addition, works great!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim msg As Variant, Lngcounter As Integer
If Target.Cells.count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For i = 4 To 13
        Lngcounter = Lngcounter + 1
        msg = msg & Lngcounter & "  " & Cells(Target.row, i).value & vbCrLf     ' ", "
    Next
    MsgBox msg
End If
End Sub

 

[JLGWhiz]

Thanks for reply! Here is my revised addition, works great!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim msg As Variant, Lngcounter As Integer
If Target.Cells.count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For i = 4 To 13
        Lngcounter = Lngcounter + 1
        msg = msg & Lngcounter & "  " & Cells(Target.row, i).value & vbCrLf     ' ", "
    Next
    MsgBox msg
End If
End Sub

Thanks for the feed back,
Regards, JLG

 

[zrx1200]

Thanks for the feed back,
Regards, JLG

Trying to push further... This will add a time found to the list but fails error 1004 unable to get vlookup property of worksheet class ???

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim msg As Variant, Lngcounter As Integer
Dim DeliveryTime As Variant
Dim Lookup_Range As Range
Set Lookup_Range = Worksheets("Data").Range("A2:D195")
Dim thisvalue As String
If Target.Cells.count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
 
    For i = 4 To 13
'      thisvalue = Cells(Target.row, i).value
'       DeliveryTime = Application.WorksheetFunction.VLookup(thisvalue, Lookup_Range, 2, False)
        Lngcounter = Lngcounter + 1
        msg = msg & Lngcounter & "  " & Cells(Target.row, i).value & vbCrLf & "  " & Application.WorksheetFunction.VLookup(Cells(Target.row, i).value, Lookup_Range, 2, False)
'        thisvalue = ""
    Next
    MsgBox msg
End If
End Sub

 

[zrx1200]

Trying to push further... This will add a time found to the list but fails error 1004 unable to get vlookup property of worksheet class ???

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim msg As Variant, Lngcounter As Integer
Dim DeliveryTime As Variant
Dim Lookup_Range As Range
Set Lookup_Range = Worksheets("Data").Range("A2:D195")
Dim thisvalue As String
If Target.Cells.count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
 
    For i = 4 To 13
'      thisvalue = Cells(Target.row, i).value
'       DeliveryTime = Application.WorksheetFunction.VLookup(thisvalue, Lookup_Range, 2, False)
        Lngcounter = Lngcounter + 1
        msg = msg & Lngcounter & "  " & Cells(Target.row, i).value & vbCrLf & "  " & Application.WorksheetFunction.VLookup(Cells(Target.row, i).value, Lookup_Range, 2, False)
'        thisvalue = ""
    Next
    MsgBox msg
End If
End Sub

Solved.

The value if nothing was causing error. Solution in code.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim msg As Variant, Lngcounter As Integer
Dim DeliveryTime As Variant
Dim Lookup_Range As Range
Set Lookup_Range = Worksheets("Data").Range("A2:D195")
Dim thisvalue As String
If Target.Cells.count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
 
    For i = 4 To 13
      thisvalue = Cells(Target.row, i).value
      If thisvalue = "" Then Exit For
       DeliveryTime = Application.WorksheetFunction.VLookup(thisvalue, Lookup_Range, 3, False)
        Lngcounter = Lngcounter + 1
        msg = msg & Lngcounter & "  " & Cells(Target.row, i).value & "      " & Format(DeliveryTime, "h:mm ") & vbCrLf
'        thisvalue = ""
    Next
    MsgBox msg
End If
End Sub