Populate data in columns and print preview

[YasserKhalil]

Never mind my tutor.I appreciate a lot your help and your patience
Best Regards

[YasserKhalil]

This issue is solved at the other link by Mr. Karedog
Here's the code to be a reference for other members (if there is anyone interested)

Code: Select all

Sub Test()
  Dim a, b, i As Long, j As Long, k As Long, m As Long, v1, v2, v3, z As New Collection
  Const blk As Long = 40
  Const grp As Long = 4
  Const off As Long = 3

  With Sheets("Data")
    a = .Range("P2:U" & .Cells(.Rows.Count, "P").End(xlUp).Row).Value
  End With
  For i = 1 To UBound(a, 1)
      On Error Resume Next
         z.Add key:=a(i, 5), Item:=New Collection
      On Error GoTo 0
      z(a(i, 5)).Add Array(a(i, 1), a(i, 6))
  Next i

  With Sheets("SP")
    For Each v1 In z
        .UsedRange.ClearContents
        .UsedRange.Borders.Value = 0
        .ResetAllPageBreaks
        ReDim a(1 To v1.Count, 1 To 2)
        i = 0
        For Each v2 In v1
            i = i + 1
            a(i, 1) = v2(0)
            a(i, 2) = v2(1)
        Next v2
        For i = 1 To UBound(a, 1) - 1
            For j = i + 1 To UBound(a, 1)
                If a(j, 1) < a(i, 1) Then
                   v3 = a(i, 1): a(i, 1) = a(j, 1): a(j, 1) = v3
                   v3 = a(i, 2): a(i, 2) = a(j, 2): a(j, 2) = v3
                End If
            Next j
        Next i
        ReDim b(1 To ((UBound(a, 1) \ blk) + 1) * blk, 1 To grp * off)
        k = 1 - off
        m = 1
        For i = 1 To UBound(a, 1)
            If i Mod blk = 1 Then
               k = k + off
               If k > UBound(b, 2) Then
                  m = m + blk + 1
                  k = 1
               End If
               j = m
               b(j, k) = "Seat"
               b(j, k + 1) = "Secret"
            End If
            j = j + 1
            b(j, k) = a(i, 1)
            b(j, k + 1) = a(i, 2)
        Next i
        With .Range("A1").Resize(UBound(b, 1), UBound(b, 2))
          .Value = b
          .SpecialCells(xlCellTypeConstants).Borders.Weight = xlThin
          For i = 1 To .SpecialCells(xlCellTypeConstants).Rows.Count Step blk + 1
              If i > 1 Then .Parent.HPageBreaks.Add .Cells(i, 1)
          Next i
        End With
        .PrintPreview
  Next v1
  End With
End Sub

[HansV]

I'm glad your problem has been solved.

[YasserKhalil]

Thanks a lot Mr. Hans
Best and Kind Regards