Data Validation VBA Input Message

[default_name]

Hello,

I have a large batch of data.
There are 5 different types of data. Every 5 rows, there is a new set of data.
I am trying to implement Data Validation Input Messages so that when a user is on a certain cell, they will know what type of data is being referenced.
Not sure if that makes sense....i'll try to illustrate:

​ A​ B​ C​ D​ E​ F​ . . .​ AS​ 1​ TypeA​ 55​ 12​ 16​ 9​ 5​ . . .​ 37​ 2​ TypeB​ 57​ 73​ 82​ 99​ 21​ . . .​ 0​ 3​ TypeC​ 0​ 0​ 4​ 18​ 6​ . . .​ 8​ 4​ TypeD​ 9​ 9​ 5​ 25​ 4​ . . .​ 66​ 5​ TypeE​ 1​ 1​ 38​ 7​ 0​ . . .​ 5​ 6​ TypeA​ 8​ 4​ 42​ 71​ 22​ . . .​ 15​ 7​ TypeB​ 65​ 8​ 31​ 5​ 79​ . . .​ 0​ 8​ TypeC​ 455​ 26​ 31​ 30​ 15​ . . .​ 43​ 9​ TypeD​ 98​ 99​ 2​ 0​ 3​ . . .​ 13​ 10​ TypeE​ 5​ 6​ 5​ 1​ 2​ . . .​ 18​ . . .​ . . .​ . . .​ . . .​ . . .​ . . .​ . . .​ ​ . . .​ 2005​ TypeE​ 66​ 8​ 32​ 6​ 4​ . . .​ 52​

<--This is similar to what my data looks like. Let's say that I happen to have cell F7 selected. The data validation message would appear saying "TypeB" (since F7 is in the TypeB row). [Is there a way to have the message reference the data type from column A?] I want this little note box to appear because as you get further to the right (let's say cell AS4) in order to see what type the item is (TypeD in this example for AS4), the user would have to scroll all the way back over to the left. I know this can also be done by freezing the first column pane...but I don't want to use this method. This type of data continues to the bottom of the table (which occaisonally grows longer) [in this example there are currently 2005 rows]. The TypeA, TypeB....pattern continues every 5 rows until the bottom of the table. Is there a way to assign this data validation pattern to all the rows to the end of the table (B1:AS2005 in this example)?

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Click on any cell in B:AS.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("B:AS")) Is Nothing Then Exit Sub
    MsgBox Range("A" & Target.Row)
End Sub

 

[DanteAmor]

Here another macro for you to consider.

The type will appear as a cell message:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B:AS")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    
    On Error Resume Next
      Application.EnableEvents = False
      Cells.SpecialCells(xlCellTypeComments).ClearComments
      Application.EnableEvents = True
    On Error GoTo 0
        
    Target.AddComment
    Target.Comment.Visible = True
    Target.Comment.Text Text:="" & Cells(Target.Row, "A").Value
    Target.Comment.Shape.TextFrame.AutoSize = True
    
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up. Select a cell and message
will appear.

 

[default_name]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Click on any cell in B:AS.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("B:AS")) Is Nothing Then Exit Sub
    MsgBox Range("A" & Target.Row)
End Sub

Thanks mumps!
This code is almost exactly what I was hoping for.
Only one thing...is there any way that the message box appears on the side of the selected cell (similar to a comment)?
This is the manner in which Data Validation Input Messages appear.

[Update] Dante answered this question at the exact same time that I posted this message.

 

[default_name]

Here another macro for you to consider.

The type will appear as a cell message:

View attachment 7858

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B:AS")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
  
    On Error Resume Next
      Application.EnableEvents = False
      Cells.SpecialCells(xlCellTypeComments).ClearComments
      Application.EnableEvents = True
    On Error GoTo 0
      
    Target.AddComment
    Target.Comment.Visible = True
    Target.Comment.Text Text:="" & Cells(Target.Row, "A").Value
    Target.Comment.Shape.TextFrame.AutoSize = True
  
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up. Select a cell and message
will appear.

This works perfectly!! Thanks for your help!

Is there a way to exclude the first row (the header row)? I should have showed a header in my example (my mistake).
Thanks again!

 

[default_name]

Just encountered an interesting error.
DantaAmor, your code worked when I first entered it in. (while in Unprotected mode)
However, when I Protect the file it doesnt seem to function the same.

Whenever I move around in the worksheet (while it is Protected) it leaves a visible comment on the cell. The cell comment then remains visible even if I move to other cells on the sheet.
Is there a way to mkae this code function the same while it is Protected?

Also is there a way to skip the top row (header row)?

Thanks again!

 

[DanteAmor]

when I Protect the file

You mean protect the sheet?
If so, try the following, change "abc" for your sheet password.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B:AS")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
    
    ActiveSheet.Unprotect "abc"
    
      On Error Resume Next
        Application.EnableEvents = False
        Cells.SpecialCells(xlCellTypeComments).ClearComments
        Application.EnableEvents = True
      On Error GoTo 0

      If Cells(Target.Row, "A").Value <> "" Then
        Target.AddComment
        Target.Comment.Visible = True
        Target.Comment.Text Text:="" & Cells(Target.Row, "A").Value
        Target.Comment.Shape.TextFrame.AutoSize = True
      End If

    ActiveSheet.Protect "abc"
  End If
End Sub

 

[default_name]

You mean protect the sheet?
If so, try the following, change "abc" for your sheet password.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B:AS")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
   
    ActiveSheet.Unprotect "abc"
   
      On Error Resume Next
        Application.EnableEvents = False
        Cells.SpecialCells(xlCellTypeComments).ClearComments
        Application.EnableEvents = True
      On Error GoTo 0

      If Cells(Target.Row, "A").Value <> "" Then
        Target.AddComment
        Target.Comment.Visible = True
        Target.Comment.Text Text:="" & Cells(Target.Row, "A").Value
        Target.Comment.Shape.TextFrame.AutoSize = True
      End If

    ActiveSheet.Protect "abc"
  End If
End Sub

Hi Dante,
Yeah I meant to say "protect the sheet".
However, although protected, it is not password protected. Is there a way to make this work without the password protection?

 

[DanteAmor]

Try this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B:AS")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
    
    ActiveSheet.Unprotect
    
      On Error Resume Next
        Application.EnableEvents = False
        Cells.SpecialCells(xlCellTypeComments).ClearComments
        Application.EnableEvents = True
      On Error GoTo 0

      If Cells(Target.Row, "A").Value <> "" Then
        Target.AddComment
        Target.Comment.Visible = True
        Target.Comment.Text Text:="" & Cells(Target.Row, "A").Value
        Target.Comment.Shape.TextFrame.AutoSize = True
      End If

    ActiveSheet.Protect
  End If
End Sub

 

[default_name]

Try this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B:AS")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
   
    ActiveSheet.Unprotect
   
      On Error Resume Next
        Application.EnableEvents = False
        Cells.SpecialCells(xlCellTypeComments).ClearComments
        Application.EnableEvents = True
      On Error GoTo 0

      If Cells(Target.Row, "A").Value <> "" Then
        Target.AddComment
        Target.Comment.Visible = True
        Target.Comment.Text Text:="" & Cells(Target.Row, "A").Value
        Target.Comment.Shape.TextFrame.AutoSize = True
      End If

    ActiveSheet.Protect
  End If
End Sub

Perfection! You are amazing!
Thank you!