Create a list in a message box

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi,

I am trying to create a msgbox that has a list of items.

I have values in a column E. If the value in this column is greater than 1 I would like to take the information from columns B, C, D of the same row.

There might be no lines where the value is greater than 1 and there might be more than 20 which means I would need a second msgbox.

Below is code I am trying to adapt which works well in other workbooks I use. It has been corrupted by me playing around on it so pay it no attention other than the general direction I am trying to go.

Any help appreciated.

Thanks


Sub PAGES()



Cells.Select
Rows.Hidden = False
Dim PageCount(), Descr(), Page(), Price() As Long, lMax As Long, lNoRows As Long, i As Long
Dim Rng As Range
Dim sMsg As String
Const MAX_TO_SHOW = 10000

ReDim PageCount(1 To MAX_TO_SHOW)
Set Rng = Range(Cells.Find(What:="MULTIBUY QTY", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 0), Cells.Find(What:="MULTIBUY QTY", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(10000).End(xlUp))

Cells.Find(What:="MULTIBUY QTY", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(1, 0).Select

lNoRows = Application.WorksheetFunction.CountIf(Rng, ">1")

For i = 1 To UBound(PageCount)
If Cells(i + 1, ActiveCell.Column) > 1 Then

Descr(i) = Cells(i + 1, 2).Value
Page(i) = Cells(i + 1, 3)
Price(i) = Cells(i + 1, 5) & " for $" & Cells(i, 4) * Cells(i + 1, 5)
Else
If lCount = lNoRows Then Exit For
End If
Next i

If i > UBound(PageCount) Then
lMax = i - 1
Else
lMax = i
End If


sMsg = "Description Page No: Multibuy Value"
For i = 1 To 20
If PageCount(i) > 0 Then 'optional
sMsg = sMsg & vbNewLine & " " & i & " " & PageCount(i)
End If 'optional
Next i
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
MsgBox sMsg, , "NUMBER OF FEATURES PER PAGE"

sMsg2 = "Page No: Number of Features"
If Application.WorksheetFunction.Max(Range("B10:B10000")) > 20 Then
For i = 21 To 40
If PageCount(i) > 0 Then 'optional
sMsg2 = sMsg2 & vbNewLine & " " & i & " " & PageCount(i)
End If 'optional
Next i
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
MsgBox sMsg2, , "NUMBER OF FEATURES PER PAGE"
End If

sMsg3 = "Page No: Number of Features"
If Application.WorksheetFunction.Max(Range("B10:B10000")) > 40 Then
For i = 41 To 60
If PageCount(i) > 0 Then 'optional
sMsg = sMsg3 & vbNewLine & " " & i & " " & PageCount(i)
End If 'optional
Next i
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
MsgBox sMsg3, , "NUMBER OF FEATURES PER PAGE"
End If



End Sub
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,554
Below is code I am trying to adapt which works well in other workbooks I use. It has been corrupted by me playing around on it so pay it no attention other than the general direction I am trying to go.
Hmm, this looks vaguely familiar: http://www.mrexcel.com/forum/excel-questions/841771-message-box-dynamic-content.html:)

? I'm guessing that your general direction is something like this at its simplest:

Code:
Sub ShowValues()

    Dim vValues As Variant
    Dim sMsg As String
    Dim lcount As Long, i As Long
    Const MAX_TO_SHOW = 20
    
    vValues = Range("B1:E" & Range("E" & Rows.Count).End(xlUp).Row).Value
        
    sMsg = "Rows where Column E > 1:"
    For i = 1 To UBound(vValues, 1)
        If vValues(i, 4) > 1 Then _
            lcount = lcount + 1
            sMsg = sMsg & vbNewLine & vValues(i, 1) & " " & vValues(i, 2) & vValues(i, 3)
            If lcount = MAX_TO_SHOW Then Exit For
    Next i
    
    MsgBox sMsg

End Sub
What do you want to do after 20? Keep providing message boxes until the user says stop?
 

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Thanks Stephen.

What if there was 200 rows but there was only 2 instances where E > 1, how would I not have all the blank spaces between the results?
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,554
Oops sorry, the IF() block should have been:

Code:
        If vValues(i, 4) > 1 Then
            lcount = lcount + 1
            sMsg = sMsg & vbNewLine & vValues(i, 1) & " " & vValues(i, 2) & vValues(i, 3)
            If lcount = MAX_TO_SHOW Then Exit For
        End If
 

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi Stephen,

Great! That looks like it is working now.

Two more questions:
1. How would I amend the code if the results exceed the character limitation of the message box?

2. Any tips on spacing the values apart as the length of each cell value varies.

Thanks
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,554
1. How would I amend the code if the results exceed the character limitation of the message box?

2. Any tips on spacing the values apart as the length of each cell value varies.
1. I wouldn't use message boxes myself to show large amounts of information. Depending on what you're trying to achieve, alternative methods would include:

a) Using conditional formatting to highlight the "discrepancies".

b) Have the message box say : There are more than n discrepancies, here are the first n: ..."

c) Write all the discrepancies to a debug sheet in the workbook, or create a separate debug report.

2. You can use vbTab rather than " " to separate the values, and also Format() the values. This will improve the alignment, but I doubt you'll make it perfect.
 

bayles

Board Regular
Joined
Oct 31, 2013
Messages
54
Hi Stephen,

Thanks again for the suggestions.

Here is my final code which appears to be working. the text in the first column can range from a Len of 10 to 50 so I just limited it to 20 characters and played around with vbtab. I also did a check on the len of the sMsg and when it exceeded 900 characters I would create a second msgbox. If it was less than 1000 then just the one msgbox would be shown.

It might not be perfect in code or on screen always but serves it purpose.

Thanks

Sub CHECK_MULTIS()


Dim vValues As Variant
Dim sMsg As String
Dim lcount As Long, i As Long

vValues = Range(Cells.Find(What:="MULTIBUY QTY", After:=Range("A1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(0, -3), Cells(Cells.Find(What:="MULTIBUY QTY", After:=Range("A1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Offset(10000, 0).End(xlUp).Row, Cells.Find(What:="MULTIBUY QTY", After:=Range("A1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column))

sMsg = "Description" & vbTab & vbTab & vbTab & "Page No:" & vbTab & "Multibuy Value"
For i = 2 To UBound(vValues, 1)


If vValues(i, 4) > 1 Then
lcount = lcount + 1
If Len(vValues(i, 1)) < 20 Then
sMsg = sMsg & vbNewLine & Left(vValues(i, 1), 20) & "...." & vbTab & vbTab & vbTab & vValues(i, 2) & vbTab & vValues(i, 4) & " for $" & Round(vValues(i, 3) * vValues(i, 4), 2)
Else
sMsg = sMsg & vbNewLine & Left(vValues(i, 1), 20) & "...." & vbTab & vbTab & vValues(i, 2) & vbTab & vValues(i, 4) & " for $" & Round(vValues(i, 3) * vValues(i, 4), 2)
End If
If Len(sMsg) > 900 Then
msg = MsgBox(sMsg, vbOKCancel, "CHECK MULTIBUYS")
If msg = vbCancel Then
End
End If
sMsg = "Description" & vbTab & vbTab & vbTab & "Page No:" & vbTab & "Multibuy Value"
End If
End If


Next i

msg = MsgBox(sMsg, vbOKCancel, "CHECK MULTIBUYS")



End Sub
 

Forum statistics

Threads
1,081,981
Messages
5,362,535
Members
400,679
Latest member
alecalec202

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top