Set the print area appropriately

[jackjoush]

Hello everyone
This code has been created To transfer Specific columns from the CustomersData sheet to two sheets ( monetary & Delayed ) based on in columns T & S

Code: Select all

Sub test()
    Dim LR As Long, x As Long, i As Long, j As Long, z As Long, xx As Long, K As Long, L As Long
    
    Application.ScreenUpdating = 0
    With Sheets("CustomersData")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        ReDim Arr(1 To LR, 1 To 64)
        ReDim MM(1 To LR, 1 To 17)
        ReDim DD(1 To LR, 1 To 7)
        Arr = .Range("A8", "BL" & LR).Value
        
        Dim WS As Worksheet
        Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
        
        WS.Range("A8", "BL" & LR) = Arr
        WS.Sort.SortFields.Clear

        WS.Sort.SortFields.Add Key:=Range("D8", "D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        WS.Sort.SortFields.Add Key:=Range("C8", "C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
        With WS.Sort
            .SetRange Range("A8", "BL" & LR)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        Arr = WS.Range("A8", "BL" & LR).Value
        Application.DisplayAlerts = False
        WS.Delete
        Application.DisplayAlerts = True
        
        i = 1: j = 1: K = 1: L = 1
        For x = 1 To UBound(Arr)
            
            
            If Arr(x, 19) = "Cash payment" Then
                MM(i, 1) = K: MM(i, 2) = "'" & Arr(x, 2): MM(i, 3) = Arr(x, 3): MM(i, 4) = Arr(x, 4)
                MM(i, 5) = Arr(x, 11): MM(i, 6) = Arr(x, 35): MM(i, 7) = Arr(x, 36): MM(i, 8) = Arr(x, 13): MM(i, 9) = Arr(x, 14): MM(i, 10) = Arr(x, 15): MM(i, 11) = Arr(x, 16): MM(i, 12) = Arr(x, 17): MM(i, 13) = Arr(x, 18): MM(i, 14) = Arr(x, 43): MM(i, 15) = Arr(x, 44): MM(i, 16) = Arr(x, 61): MM(i, 17) = Arr(x, 62)
                z = z + 1
                K = K + 1
                If z = 25 Then
                z = 0: i = i + 5
                Else
                    i = i + 1
                    
                End If
            End If
            
            If Arr(x, 20) = "Deferred payment" Then
                DD(j, 1) = L: DD(j, 2) = "'" & Arr(x, 2): DD(j, 3) = Arr(x, 3): DD(j, 4) = Arr(x, 4)
                DD(j, 5) = Arr(x, 43): DD(j, 6) = Arr(x, 44): DD(j, 7) = Arr(x, 24)
                xx = xx + 1
                L = L + 1
                If xx = 30 Then
                    xx = 0: j = j + 5
                Else
                    j = j + 1
                End If
            End If
        Next
         
         With Sheets("monetary")
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            If LR > 6 Then .Range("A8", "Q" & LR).ClearContents
            .Range("A8").Resize(UBound(Arr), 17) = MM
            For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 29, 0)
                .HPageBreaks.Add Before:=Cells(29 * i + 8, 1)
                .Cells(29 * i + 4, 1) = "Storekeeper" & String(50, " ") & "Storekeeper2" & String(50, " ") & "Storekeeper3" & String(50, " ") & "Storekeeper4"
                
                .Range("A" & 29 * i + 4, "Q" & 29 * i + 4).HorizontalAlignment = xlCenterAcrossSelection
                
                
                     '      inserting tables borders for each row 25
                     '      How can I customize preferences such as font type, font size, row height, and so on
                     
                     '     .Range("A" & 29 * i + 4, "Q" & 29 * i + 4).HorizontalAlignment = xlCenterAcrossSelection
                     '     .PageSetup.PrintArea =
                          .PageSetup.PrintTitleRows = "$1:$7"
            Next
        End With
        
        With Sheets("Delayed")
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            
            If LR > 6 Then .Range("A8", "Q" & LR).ClearContents
            .Range("A8").Resize(UBound(Arr), 7) = DD
            For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 34, 0)
                .HPageBreaks.Add Before:=Cells(34 * i + 8, 1)
                .Cells(34 * i + 4, 1) = "Storekeeper" & String(70, " ") & "Storekeeper1" & String(70, " ") & "Storekeeper2"
                
                .Range("A" & 34 * i + 4, "G" & 34 * i + 4).HorizontalAlignment = xlCenterAcrossSelection
                
                     '      inserting tables borders for each row 30
                     
                     '     .Range("A" & 34 * i + 4, "G" & 34 * i + 4).HorizontalAlignment = xlCenterAcrossSelection
                     '     .PageSetup.PrintArea =
                          .PageSetup.PrintTitleRows = "$1:$7"
            Next
        End With
    End With
End Sub

It does work fine but I failed with inserting tables borders at fixed number of rows and also set the print area appropriately
and also Customize some preferences for font type, font size, rows height, and columns width.
Attached sample may clarify more ... Really appreciate you guys help.
Thank you very much for all of you

[HansV]

Welcome to Eileen's Lounge!

Please explain in detail what you want to do:
- Where do you want borders?
- How do you want to set row heights and column widths?
- Where do you want to apply fonts, and which ones?

[jackjoush]

Thank you very much Mr. Hans
I want to inserting tables borders starting in the eighth row In both sheets ( monetary & Delayed ) But with a different number of rows.
In the sheet ( monetary ) The data will be transferred for each 25 row.
In the sheet ( Delayed ) The data will be transferred for each 30 row.
With leaving 3 blank rows without borders below the signatures In both sheets ( monetary & Delayed ).
as for The goal of set row heights and column widths and customize some of the preferences In both sheets ( monetary & Delayed )
is to Adjust the print area horizontally and vertically. this is To my knowledge As a beginner
Any help would be greatly appreciated!!! - thanks in advance

[HansV]

See the attached version.

sample.xlsm

[jackjoush]

Thank you very much Mr. Hans
I added these two lines in the code to set the print area Using the definition of print range for both sheets ( monetary & Delayed )
This is for the sheet monetary

Code: Select all

  Next i
       .PageSetup.PrintArea = [Criteria].Address
       .PageSetup.PrintTitleRows = "$1:$7"
        End With

The formula used

Code: Select all

=OFFSET(monetary!$A$1:$Q$1;;;29*ROUNDUP((MATCH(MAX(monetary!$A:$A);monetary!$A:$A;0)-7)/29;0)+7)

and This is for the sheet Delayed

Code: Select all

  Next i
        .PageSetup.PrintArea = [Criteria1].Address
        .PageSetup.PrintTitleRows = "$1:$7"
        End With

The formula used

Code: Select all

=OFFSET(Delayed!$A$1:$G$1;;;34*ROUNDUP((MATCH(MAX(Delayed!$A:$A);Delayed!$A:$A;0)-7)/34;0)+7)

My final question is how can Customize some preferences for font type, font size, rows height, and columns width So is the alignment and so on.
To find out the problem, please run the code to see what I mean
Thank you very much in advance.

[HansV]

Is this better?

Code: Select all

Sub test()
    Dim LR As Long, x As Long, i As Long, j As Long, z As Long, xx As Long, K As Long, L As Long
    Dim WS As Worksheet

    Application.ScreenUpdating = False
    With Sheets("CustomersData")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        ReDim Arr(1 To LR, 1 To 64)
        ReDim MM(1 To LR, 1 To 17)
        ReDim DD(1 To LR, 1 To 7)
        Arr = .Range("A8", "BL" & LR).Value
    End With

    Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))

    WS.Range("A8", "BL" & LR) = Arr
    WS.Sort.SortFields.Clear
    WS.Sort.SortFields.Add Key:=Range("D8", "D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    WS.Sort.SortFields.Add Key:=Range("C8", "C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With WS.Sort
        .SetRange Range("A8", "BL" & LR)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Arr = WS.Range("A8", "BL" & LR).Value
    Application.DisplayAlerts = False
    WS.Delete
    Application.DisplayAlerts = True

    i = 1: j = 1: K = 1: L = 1
    For x = 1 To UBound(Arr)
        If Arr(x, 19) = "Cash payment" Then
            MM(i, 1) = K: MM(i, 2) = "'" & Arr(x, 2): MM(i, 3) = Arr(x, 3): MM(i, 4) = Arr(x, 4)
            MM(i, 5) = Arr(x, 11): MM(i, 6) = Arr(x, 35): MM(i, 7) = Arr(x, 36): MM(i, 8) = Arr(x, 13): MM(i, 9) = Arr(x, 14): MM(i, 10) = Arr(x, 15): MM(i, 11) = Arr(x, 16): MM(i, 12) = Arr(x, 17): MM(i, 13) = Arr(x, 18): MM(i, 14) = Arr(x, 43): MM(i, 15) = Arr(x, 44): MM(i, 16) = Arr(x, 61): MM(i, 17) = Arr(x, 62)
            z = z + 1
            K = K + 1
            If z = 25 Then
            z = 0: i = i + 5
            Else
                i = i + 1
            End If
        End If

        If Arr(x, 20) = "Deferred payment" Then
            DD(j, 1) = L: DD(j, 2) = "'" & Arr(x, 2): DD(j, 3) = Arr(x, 3): DD(j, 4) = Arr(x, 4)
            DD(j, 5) = Arr(x, 43): DD(j, 6) = Arr(x, 44): DD(j, 7) = Arr(x, 24)
            xx = xx + 1
            L = L + 1
            If xx = 30 Then
                xx = 0: j = j + 5
            Else
                j = j + 1
            End If
        End If
    Next x

    With Sheets("monetary")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        If LR > 6 Then .Range("A8", "Q" & LR).Clear
        .Range("A8").Resize(UBound(Arr), 17) = MM
        For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 29, 0)
            .Range("A" & 29 * i - 21 & ":Q" & 29 * i + 3).Borders.LineStyle = xlContinuous
            .HPageBreaks.Add Before:=Cells(29 * i + 8, 1)
            .Cells(29 * i + 4, 1) = "Storekeeper" & String(50, " ") & "Storekeeper2" & String(50, " ") & "Storekeeper3" & String(50, " ") & "Storekeeper4"
            .Range("A" & 29 * i + 4, "Q" & 29 * i + 4).HorizontalAlignment = xlCenterAcrossSelection
        Next i
        .PageSetup.PrintArea = [Criteria].Address
        .PageSetup.PrintTitleRows = "$1:$7"
        With .UsedRange.Font
            .Name = "Cambria"
            .Size = 14
            .Bold = True
        End With
        .Range("A1:Q1").EntireColumn.AutoFit
        .Range("F1:G1").ColumnWidth = 7.29
        .Range("O1:Q1").ColumnWidth = 7.29
        .Range("A6").RowHeight = 55.5
    End With

    With Sheets("Delayed")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        If LR > 6 Then .Range("A8", "Q" & LR).Clear
        .Range("A8").Resize(UBound(Arr), 7) = DD
        For i = 1 To Application.RoundUp((Application.Match(9 ^ 9, .Range("A:A"), 1) - 7) / 34, 0)
            .Range("A" & 34 * i - 26 & ":G" & 34 * i + 3).Borders.LineStyle = xlContinuous
            .HPageBreaks.Add Before:=Cells(34 * i + 8, 1)
            .Cells(34 * i + 4, 1) = "Storekeeper" & String(70, " ") & "Storekeeper1" & String(70, " ") & "Storekeeper2"
            .Range("A" & 34 * i + 4, "G" & 34 * i + 4).HorizontalAlignment = xlCenterAcrossSelection
        Next i
         .PageSetup.PrintArea = [Criteria1].Address
        .PageSetup.PrintTitleRows = "$1:$7"
        With .UsedRange.Font
            .Name = "Cambria"
            .Size = 14
            .Bold = True
        End With
    End With
End Sub

[jackjoush]

Thank you very much Mr. Hans
That is absolutely beautiful. Thank you so much.
Best wishes