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