Message box that shows the column and the last data in that column.

[danbates]

Hi,

I've tried looking this up but I haven't found anything close to what I am wanting.

I would like a code that when triggered, shows the column letter and what data is in the last row of that column in a message box.

The columns are A to L.

I hope this makes sense and any help would be much appreciated.

Thanks

Dan

 

[My Aswer Is This]

Try this:

Sub Active_Column()
'Modified 10/10/2018 9:40 PM  EDT
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim ans As String
Dim aa As String
Dim ss As String
    For i = 1 To 12
        Lastrow = Cells(Rows.Count, i).End(xlUp).Row
        bb = Cells(Lastrow, i).Value
        ans = ans & "  " & Cells(1, i).Address & "  " & bb & vbNewLine
    Next

aa = Replace(ans, "$", "")
ss = Replace(aa, "1", "")
Application.ScreenUpdating = False
MsgBox ss
End Sub

 

[Peter_SSs]

I hope this makes sense ...

Some clarification may help if your query is not yet resolved.

1. Are you looking to report the last values for all 12 columns A:L or just the one column that the Active Cell is in?

2. Do you have any formal Excel tables (created through Insert -> Table for example) in the targeted columns?

3. Do you have any formulas in the relevant columns? If so, and for example, the last thing visible in column C might be 123 but below that might be a formula that returns "" which you cannot see, what do you want the message box to show? That actual last cell (that appears blank) or the 123 which is the last visible thing in the column?

These cover some of the above, but in each case report the last non-blank cell in the column

For all columns A:L

Sub LastValuesAllColumns()
  Dim i As Long
  Dim msg As String
  Dim cLast As Range
  
  For i = 1 To 12
    Set cLast = Columns(i).Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious)
    msg = msg & vbLf & Replace(Cells(1, i).Address(0, 0), 1, "") & ":  "
    If Not cLast Is Nothing Then msg = msg & cLast.Text
  Next i
  MsgBox msg
End Sub

For active cell column

Sub LastValueActiveCellColumn()
  Dim cLast As Variant
  Dim msg As String
  
  If ActiveCell.Column < 13 Then
    msg = Split(ActiveCell.Address, "$")(1) & ":  "
    Set cLast = ActiveCell.EntireColumn.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious)
    If Not cLast Is Nothing Then msg = msg & cLast.Text
    MsgBox msg
  End If
End Sub

MAIT
Your code needs some refinement. For example, test where the last cell in one of the columns is
Cost is $45
or the date
1/01/2011

 

[My Aswer Is This]

To make some changes:
Try this:

Sub New_Column()
'Modified  10/10/2018  11:42:55 PM  EDT
Application.ScreenUpdating = False
Dim cc As Long
Dim Del As Variant
Del = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L")
cc = UBound(Del)
Dim Lastrow As Long
Dim ans As String
Dim aa As String
Dim ss As String
    For i = 1 To cc + 1
        Lastrow = Cells(Rows.Count, i).End(xlUp).Row
        bb = Cells(Lastrow, i).Value
        ans = ans & "  " & Del(i - 1) & "  " & bb & vbNewLine
    Next

MsgBox ans
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Well I forgot to remove some Dim statements no longer needed so:
Try this:

Sub New_Column()
'Modified  10/10/2018  11:55:15 PM  EDT
Application.ScreenUpdating = False
Dim cc As Long
Dim Lastrow As Long
Dim ans As String
Dim bb As String
Dim Del As Variant
Del = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L")
cc = UBound(Del)

    For i = 1 To cc + 1
        Lastrow = Cells(Rows.Count, i).End(xlUp).Row
        bb = Cells(Lastrow, i).Value
        ans = ans & "  " & Del(i - 1) & "  " & bb & vbNewLine
    Next

MsgBox ans
Application.ScreenUpdating = True
End Sub

 

[danbates]

Hi,

Thank you both for your replies but Peter_SSs you are right about my cells having formulas, it never entered my head to mention, sorry.

Your fist code works just as I wanted.

There is one thing extra I'd like to ask, is it possible instead of having the column letter in the message box could I have the column headers?

If so the column headers are in cells A2:L2.

Thank you both again for you help.

Regards

Dan

 

[Peter_SSs]

Thank you both for your replies but Peter_SSs you are right about my cells having formulas, it never entered my head to mention, sorry.

Your fist code works just as I wanted.

There is one thing extra I'd like to ask, is it possible instead of having the column letter in the message box could I have the column headers?

If so the column headers are in cells A2:L2.

Try this version. The layout in the message box might be a bit 'ugly' if you have headings of different length.

Sub LastValuesAllColumns_v2()
  Dim i As Long
  Dim msg As String
  Dim cLast As Range
  
  For i = 1 To 12
    Set cLast = Columns(i).Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious)
    msg = msg & vbLf & Cells(2, i).Value & " :" & vbTab
    If cLast.Row > 2 Then msg = msg & cLast.Text
  Next i
  MsgBox msg
End Sub

If you don't like the formatting, you could try changing the msg line to

msg = msg & vbLf & vbLf & Cells(2, i).Value & " :" & vbLf & vbTab

 

[danbates]

Hi,

Thank you again for your reply.

The formatting is a bit ugly to be honest and I was wondering if it was possible to do the following:

1. Double tab columns A, B, C & F and single tab the rest? It would line everything up perfectly.
2. Have column C & F in red?

Thank you again for you help and it really isn't a problem if the last 2 are not possible.

Thanks again

Dan

 

[My Aswer Is This]

I will let Peter finish up helping you since my solution did not meet your new needs. I do not believe it's possible to have text in color in a message Box. Your original post said the column letter not the column header.
Take care

 

[My Aswer Is This]

Just in case your not aware there are lots of ways to display data on your screen other then a message box.
A message box will stop your script until you press OK. There are other ways to display data where it can be formatted exactly the way you want and which can stay visible on the screen even after the script stops.