Message box with dynamic content

[bayles]

Hi,

I know this problem can be solved with a simple userform but without me going into detail please just assume that is not an option.

I have a data set that outlines items on a page in a catalogue. The maximum number of pages will always change and the number of items on each page will also change. I am trying to create an alert to a user that summarises the number of items on each page.

My issue is that I would like to show results only for the maximum number of pages that are in the range i.e. if there are only 4 pages then I don't want to see zeros for pages 5 thru to 10. The maximum number of pages I will want to show will be 48.

Is there anyway to customise the text without having 48 If / then functions in the code?

Any help appreciated.

Sub PAGES()

Dim one, two, three, four As Integer


one = Application.WorksheetFunction.CountIf(Range("D:D"), 1)
two = Application.WorksheetFunction.CountIf(Range("D:D"), 2)
three = Application.WorksheetFunction.CountIf(Range("D:D"), 3)
four = Application.WorksheetFunction.CountIf(Range("D:D"), 4)
five = Application.WorksheetFunction.CountIf(Range("D:D"), 5)
six = Application.WorksheetFunction.CountIf(Range("D:D"), 6)
seven = Application.WorksheetFunction.CountIf(Range("D:D"), 7)
eight = Application.WorksheetFunction.CountIf(Range("D:D"), 8)
nine = Application.WorksheetFunction.CountIf(Range("D:D"), 9)
ten = Application.WorksheetFunction.CountIf(Range("D:D"), 10)


msg1 = MsgBox("Page Number Number of Features" & vbNewLine _
& " 1 " & one & vbNewLine _
& " 2 " & two & vbNewLine _
& " 3 " & three & vbNewLine _
& " 4 " & four & vbNewLine _
& " 5 " & five & vbNewLine _
& " 6 " & six & vbNewLine _
& " 7 " & seven & vbNewLine _
& " 8 " & eight & vbNewLine _
& " 9 " & nine & vbNewLine _
& " 10 " & ten, vbOKOnly, "NUMBER OF FEATURES PER PAGE")


End Sub

 

[StephenCrump]

Try this more general code:

Sub CountPages()

    Dim PageCount() As Long, lCount As Long, lMax As Long, lNoRows As Long, i As Long
    Dim rng As Range
    Dim sMsg As String
    Const MAX_TO_SHOW = 48
    
    ReDim PageCount(1 To MAX_TO_SHOW)
    Set rng = Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row)
    lNoRows = rng.Rows.Count
    
    For i = 1 To UBound(PageCount)
        PageCount(i) = WorksheetFunction.CountIf(rng, i)
        lCount = lCount + PageCount(i)
        If lCount = lNoRows Then Exit For
    Next i
    
    If i > UBound(PageCount) Then
        lMax = i - 1
    Else
        lMax = i
    End If
    
    sMsg = "Page No: Number of Features"
    For i = 1 To lMax
        If PageCount(i) > 0 Then    'optional
            sMsg = sMsg & vbNewLine & i & ": " & PageCount(i)
        End If                      'optional
    Next i
    
    MsgBox sMsg, , "NUMBER OF FEATURES PER PAGE"

End Sub

 

[bayles]

Stephen,

Thanks very much. That worked a charm straight away. Saved me many lines of code I think.

All the best
Ryan

 

[StephenCrump]

You're welcome. Thanks for the feedback.