Help with code to summing the total of decimal and integer numbers

jakjo
Lounger
Posts: 40
Joined: 28 May 2022, 00:57

Help with code to summing the total of decimal and integer numbers

Post by jakjo »

Greetings to everyone
I have this code that works well, but I need to include two formulas to calculate the total for decimal and integer numbers.

Code: Select all

Sub TransferColumns()
    Const lngHeaderRowStart = 6
    Const lngHeaderRowEnd = 7
    Const lngFirstRow = 8
    Const lngRowsPerPage = 25
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim lngLastRow As Long
    Dim lngNumRows As Long
    Dim lngNumPages As Long
    Dim i As Long
    Dim lngRow As Long

    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set wshSource = Worksheets("MasterData") ' ******
    With wshSource
        lngLastRow = .Range("A:AW").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        Set rng1 = .Range("A" & lngFirstRow & ":A" & lngLastRow)
        Set rng2 = .Range("D" & lngFirstRow & ":D" & lngLastRow)
        Set rng3 = .Range("F" & lngFirstRow & ":F" & lngLastRow)
        Set rng4 = .Range("AA" & lngFirstRow & ":AW" & lngLastRow)
    End With

    On Error Resume Next
    Application.DisplayAlerts = False
    
    Worksheets("Abstract").Delete ' ********
    
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set wshTarget = Worksheets.Add(After:=wshSource)
    
    wshTarget.Name = "Abstract" ' **********

    With wshSource
        .Range("A" & lngHeaderRowStart & ":A" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("A" & lngHeaderRowStart)
        .Range("D" & lngHeaderRowStart & ":D" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("B" & lngHeaderRowStart)
        .Range("F" & lngHeaderRowStart & ":F" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("C" & lngHeaderRowStart)
        .Range("AA" & lngHeaderRowStart & ":AW" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("D" & lngHeaderRowStart)
    End With

        With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
        .Font.Name = "Arial"
        .Font.Size = 12
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

    With wshTarget
        .Rows(lngHeaderRowStart).RowHeight = 80
        .Rows(lngHeaderRowStart + 1).RowHeight = 30
    End With

    rng1.Copy Destination:=wshTarget.Cells(lngFirstRow, "A")
    rng2.Copy Destination:=wshTarget.Cells(lngFirstRow, "B")
    rng3.Copy Destination:=wshTarget.Cells(lngFirstRow, "C")
    rng4.Copy Destination:=wshTarget.Cells(lngFirstRow, "D")

    
    
      With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
     .Font.Name = "Arial"
     .Font.Size = 12
     .Font.Bold = True
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter
     .WrapText = True
      End With
        
        With wshTarget.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .LeftMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .Zoom = 75
        .PrintTitleRows = "$1:$7"
        .PrintArea = "$A$1:$Z$" & lngLastRow
    End With

    lngNumRows = lngLastRow - lngFirstRow + 1
    lngNumPages = lngNumRows \ lngRowsPerPage
    If lngNumRows Mod lngRowsPerPage > 0 Then
        lngNumPages = lngNumPages + 1
    End If

    For i = lngNumPages - 1 To 0 Step -1
        lngRow = lngFirstRow + lngRowsPerPage * i
        If i > 0 Then
            wshTarget.Range("A" & lngRow).Resize(6).EntireRow.Insert
            wshTarget.HPageBreaks.Add Before:=wshTarget.Range("A" & lngRow + 5)
        End If
    Next i

    wshTarget.Columns("A:Z").AutoFit
    Application.Goto wshTarget.Cells(lngHeaderRowStart, "A")
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
   End Sub
The formula used for decimal numbers

Code: Select all

=MOD(SUM(100*SUM(J7:J32);I7:I32);100)
The formula used for integer numbers

Code: Select all

=INT(SUM(100*SUM(J7:J32);I7:I32)/100)
How can these two formulas be included within the code above As shown in the attachment?
Please see the attached workbook for example in Expected output sheet
Your assistance is greatly appreciated... thank you in advance
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 80088
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Help with code to summing the total of decimal and integer numbers

Post by HansV »

Code: Select all

Sub TransferColumns()
    Const lngHeaderRowStart = 6
    Const lngHeaderRowEnd = 7
    Const lngFirstRow = 8
    Const lngRowsPerPage = 25
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim lngLastRow As Long
    Dim lngNumRows As Long
    Dim lngNumPages As Long
    Dim i As Long
    Dim lngRow As Long
    Dim c As Long

    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set wshSource = Worksheets("MasterData") ' ******
    With wshSource
        lngLastRow = .Range("A:AW").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        Set rng1 = .Range("A" & lngFirstRow & ":A" & lngLastRow)
        Set rng2 = .Range("D" & lngFirstRow & ":D" & lngLastRow)
        Set rng3 = .Range("F" & lngFirstRow & ":F" & lngLastRow)
        Set rng4 = .Range("AA" & lngFirstRow & ":AW" & lngLastRow)
    End With

    On Error Resume Next
    Application.DisplayAlerts = False
    
    Worksheets("Abstract").Delete ' ********
    
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set wshTarget = Worksheets.Add(After:=wshSource)
    
    wshTarget.Name = "Abstract" ' **********

    With wshSource
        .Range("A" & lngHeaderRowStart & ":A" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("A" & lngHeaderRowStart)
        .Range("D" & lngHeaderRowStart & ":D" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("B" & lngHeaderRowStart)
        .Range("F" & lngHeaderRowStart & ":F" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("C" & lngHeaderRowStart)
        .Range("AA" & lngHeaderRowStart & ":AW" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("D" & lngHeaderRowStart)
    End With

    With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
        .Font.Name = "Arial"
        .Font.Size = 12
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

    With wshTarget
        .Rows(lngHeaderRowStart).RowHeight = 80
        .Rows(lngHeaderRowStart + 1).RowHeight = 30
    End With

    rng1.Copy Destination:=wshTarget.Cells(lngFirstRow, "A")
    rng2.Copy Destination:=wshTarget.Cells(lngFirstRow, "B")
    rng3.Copy Destination:=wshTarget.Cells(lngFirstRow, "C")
    rng4.Copy Destination:=wshTarget.Cells(lngFirstRow, "D")

    lngNumRows = lngLastRow - lngFirstRow + 1
    lngNumPages = lngNumRows \ lngRowsPerPage
    If lngNumRows Mod lngRowsPerPage > 0 Then
        lngNumPages = lngNumPages + 1
    End If

    For i = lngNumPages - 1 To 0 Step -1
        lngRow = lngFirstRow + lngRowsPerPage * i
        If i > 0 Then
            wshTarget.Range("A" & lngRow).Resize(9).EntireRow.Insert
            wshTarget.HPageBreaks.Add Before:=wshTarget.Range("A" & lngRow + 8)
        End If
        Debug.Print lngRow
        With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), 2)
            .Value = "Total Table"
            .Font.Bold = True
        End With
        If i < lngNumPages - 1 Then
            With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, 2)
                .Value = "Previous Total"
                .Font.Bold = True
            End With
        End If
        For c = 9 To 25 Step 2
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c).FormulaR1C1 = "=MOD(SUM(100*SUM(R[-26]C[1]:R[-1]C[1]),R[-26]C:R[-1]C),100)"
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c + 1).FormulaR1C1 = "=INT(SUM(100*SUM(R[-26]C:R[-1]C),R[-26]C[-1]:R[-1]C[-1])/100)"
            If i < lngNumPages - 1 Then
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c).FormulaR1C1 = "=R[-8]C"
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c + 1).FormulaR1C1 = "=R[-8]C"
            End If
        Next c
    Next i

    wshTarget.Columns("A:Z").AutoFit

    With wshTarget.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .LeftMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .Zoom = 75
        .PrintTitleRows = "$1:$7"
        '.PrintArea = "$A$1:$Z$" & lngLastRow
    End With

    Application.Goto wshTarget.Cells(lngHeaderRowStart, "A")
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
End Sub
Best wishes,
Hans

jakjo
Lounger
Posts: 40
Joined: 28 May 2022, 00:57

Re: Help with code to summing the total of decimal and integer numbers

Post by jakjo »

Thank you very very much, Mr. Hans ... I bow to your outstanding responses with deep gratitude for these brilliant solutions.
I fear that you will leave me because the code has become more complex for me, but I don't think you will leave me alone.
In fact, I tried to work on three other points, but I didn't achieve any success so far.
Therefore, I ask for your help in achieving this please, and the points are

The first point is to insert the borders, except for the 7 empty rows between the "Total" row
and the "Previous Total" row ... These rows will be for the footer.

The second point is to change the row height of the "Total" row and the "Previous Total" row to 65 points.

The third and final point is that we will leave one empty row after the "Total" row, and then we will insert some text strings as signatures
as follows: In column B: First signature ..... In column H: Second signature
In column O: Third signature .... In column X: Fourth signature

Thank you for your insight, and I wish you a happy life and good health

User avatar
HansV
Administrator
Posts: 80088
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Help with code to summing the total of decimal and integer numbers

Post by HansV »

You really like all the work done for you, don't you?

Code: Select all

Sub TransferColumns()
    Const lngHeaderRowStart = 6
    Const lngHeaderRowEnd = 7
    Const lngFirstRow = 8
    Const lngRowsPerPage = 25
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim lngLastRow As Long
    Dim lngNumRows As Long
    Dim lngNumPages As Long
    Dim i As Long
    Dim lngRow As Long
    Dim c As Long

    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set wshSource = Worksheets("MasterData") ' ******
    With wshSource
        lngLastRow = .Range("A:AW").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        Set rng1 = .Range("A" & lngFirstRow & ":A" & lngLastRow)
        Set rng2 = .Range("D" & lngFirstRow & ":D" & lngLastRow)
        Set rng3 = .Range("F" & lngFirstRow & ":F" & lngLastRow)
        Set rng4 = .Range("AA" & lngFirstRow & ":AW" & lngLastRow)
    End With

    On Error Resume Next
    Application.DisplayAlerts = False
    
    Worksheets("Abstract").Delete ' ********
    
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set wshTarget = Worksheets.Add(After:=wshSource)
    
    wshTarget.Name = "Abstract" ' **********

    With wshSource
        .Range("A" & lngHeaderRowStart & ":A" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("A" & lngHeaderRowStart)
        .Range("D" & lngHeaderRowStart & ":D" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("B" & lngHeaderRowStart)
        .Range("F" & lngHeaderRowStart & ":F" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("C" & lngHeaderRowStart)
        .Range("AA" & lngHeaderRowStart & ":AW" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("D" & lngHeaderRowStart)
    End With

    With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
        .Font.Name = "Arial"
        .Font.Size = 12
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

    With wshTarget
        .Rows(lngHeaderRowStart).RowHeight = 80
        .Rows(lngHeaderRowStart + 1).RowHeight = 30
    End With

    rng1.Copy Destination:=wshTarget.Cells(lngFirstRow, "A")
    rng2.Copy Destination:=wshTarget.Cells(lngFirstRow, "B")
    rng3.Copy Destination:=wshTarget.Cells(lngFirstRow, "C")
    rng4.Copy Destination:=wshTarget.Cells(lngFirstRow, "D")

    lngNumRows = lngLastRow - lngFirstRow + 1
    lngNumPages = lngNumRows \ lngRowsPerPage
    If lngNumRows Mod lngRowsPerPage > 0 Then
        lngNumPages = lngNumPages + 1
    End If

    For i = lngNumPages - 1 To 0 Step -1
        lngRow = lngFirstRow + lngRowsPerPage * i
        If i > 0 Then
            wshTarget.Range("A" & lngRow).Resize(9).EntireRow.Insert
            wshTarget.HPageBreaks.Add Before:=wshTarget.Range("A" & lngRow + 8)
        End If
        With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), 2)
            .Value = "Total Table"
            .Resize(1, 25).Font.Bold = True
            .Offset(0, -1).Resize(1, 26).Borders.LineStyle = xlContinuous
            .Offset(0, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
            .Offset(0, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
            .Offset(0, -1).Resize(1, 26).Font.Name = "Cambria"
            .Offset(0, -1).Resize(1, 26).Font.Size = 16
            .Offset(0, 7).Resize(1, 2).Interior.Color = 10921638
            .Offset(0, 9).Resize(1, 16).Interior.Color = 12379352
            .RowHeight = 65
            .Offset(2, 0).Value = "First signature"
            .Offset(2, 6).Value = "Second signature"
            .Offset(2, 12).Value = "Third signature"
            .Offset(2, 22).Value = "Fourth signature"
            .Offset(2, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
            .Offset(2, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
            .Offset(2, -1).Resize(1, 26).Font.Name = "Cambria"
            .Offset(2, -1).Resize(1, 26).Font.Size = 16
        End With
        If i < lngNumPages - 1 Then
            With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, 2)
                .Value = "Previous Total"
                .Font.Bold = True
                .Resize(1, 25).Font.Bold = True
                .Offset(0, -1).Resize(1, 26).Borders.LineStyle = xlContinuous
                .Offset(0, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
                .Offset(0, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
                .Offset(0, -1).Resize(1, 26).Font.Name = "Cambria"
                .Offset(0, -1).Resize(1, 26).Font.Size = 16
                .Offset(0, 7).Resize(1, 2).Interior.Color = 10921638
                .Offset(0, 9).Resize(1, 16).Interior.Color = 12379352
                .RowHeight = 65
            End With
        End If
        For c = 9 To 25 Step 2
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c).FormulaR1C1 = "=MOD(SUM(100*SUM(R[-26]C[1]:R[-1]C[1]),R[-26]C:R[-1]C),100)"
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c + 1).FormulaR1C1 = "=INT(SUM(100*SUM(R[-26]C:R[-1]C),R[-26]C[-1]:R[-1]C[-1])/100)"
            If i < lngNumPages - 1 Then
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c).FormulaR1C1 = "=R[-8]C"
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c + 1).FormulaR1C1 = "=R[-8]C"
            End If
        Next c
    Next i

    wshTarget.Columns("A:Z").AutoFit

    With wshTarget.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .LeftMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .Zoom = 75
        .PrintTitleRows = "$1:$7"
        '.PrintArea = "$A$1:$Z$" & lngLastRow
    End With

    Application.Goto wshTarget.Cells(lngHeaderRowStart, "A")
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
End Sub
Best wishes,
Hans

jakjo
Lounger
Posts: 40
Joined: 28 May 2022, 00:57

Re: Help with code to summing the total of decimal and integer numbers

Post by jakjo »

Thank you very very much Mr Hans ... I love having success with you here at Eileen's Lounge.
We will return to The first point is to insert the borders except for the 7 empty rows between the "Total" row
and the "Previous Total" row regardless of whether the main sheet "MasterData" contains borders or not.
Please add the borders in the main sheet" MasterData" then run the code and observe what I mean in the target sheet "Abstract"
With note on the last page of the tables .... Thanks a lot for your patience in this topic.

User avatar
HansV
Administrator
Posts: 80088
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Help with code to summing the total of decimal and integer numbers

Post by HansV »

Code: Select all

Sub TransferColumns()
    Const lngHeaderRowStart = 6
    Const lngHeaderRowEnd = 7
    Const lngFirstRow = 8
    Const lngRowsPerPage = 25
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim lngLastRow As Long
    Dim lngNumRows As Long
    Dim lngNumPages As Long
    Dim i As Long
    Dim lngRow As Long
    Dim c As Long

    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set wshSource = Worksheets("MasterData") ' ******
    With wshSource
        lngLastRow = .Range("A:AW").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        Set rng1 = .Range("A" & lngFirstRow & ":A" & lngLastRow)
        Set rng2 = .Range("D" & lngFirstRow & ":D" & lngLastRow)
        Set rng3 = .Range("F" & lngFirstRow & ":F" & lngLastRow)
        Set rng4 = .Range("AA" & lngFirstRow & ":AW" & lngLastRow)
    End With

    On Error Resume Next
    Application.DisplayAlerts = False
    
    Worksheets("Abstract").Delete ' ********
    
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set wshTarget = Worksheets.Add(After:=wshSource)
    
    wshTarget.Name = "Abstract" ' **********

    With wshSource
        .Range("A" & lngHeaderRowStart & ":A" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("A" & lngHeaderRowStart)
        .Range("D" & lngHeaderRowStart & ":D" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("B" & lngHeaderRowStart)
        .Range("F" & lngHeaderRowStart & ":F" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("C" & lngHeaderRowStart)
        .Range("AA" & lngHeaderRowStart & ":AW" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("D" & lngHeaderRowStart)
    End With

    With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
        .Font.Name = "Arial"
        .Font.Size = 12
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

    With wshTarget
        .Rows(lngHeaderRowStart).RowHeight = 80
        .Rows(lngHeaderRowStart + 1).RowHeight = 30
    End With

    rng1.Copy Destination:=wshTarget.Cells(lngFirstRow, "A")
    rng2.Copy Destination:=wshTarget.Cells(lngFirstRow, "B")
    rng3.Copy Destination:=wshTarget.Cells(lngFirstRow, "C")
    rng4.Copy Destination:=wshTarget.Cells(lngFirstRow, "D")

    lngNumRows = lngLastRow - lngFirstRow + 1
    lngNumPages = lngNumRows \ lngRowsPerPage
    If lngNumRows Mod lngRowsPerPage > 0 Then
        lngNumPages = lngNumPages + 1
    End If

    For i = lngNumPages - 1 To 0 Step -1
        lngRow = lngFirstRow + lngRowsPerPage * i
        If i > 0 Then
            wshTarget.Range("A" & lngRow).Resize(9).EntireRow.Insert
            wshTarget.HPageBreaks.Add Before:=wshTarget.Range("A" & lngRow + 8)
        End If
        With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), 2)
            .Value = "Total Table"
            .Resize(1, 25).Font.Bold = True
            .Offset(0, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
            .Offset(0, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
            .Offset(0, -1).Resize(1, 26).Font.Name = "Cambria"
            .Offset(0, -1).Resize(1, 26).Font.Size = 16
            .Offset(0, 7).Resize(1, 2).Interior.Color = 10921638
            .Offset(0, 9).Resize(1, 16).Interior.Color = 12379352
            .RowHeight = 65
            .Offset(2, 0).Value = "First signature"
            .Offset(2, 6).Value = "Second signature"
            .Offset(2, 12).Value = "Third signature"
            .Offset(2, 22).Value = "Fourth signature"
            .Offset(2, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
            .Offset(2, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
            .Offset(2, -1).Resize(1, 26).Font.Name = "Cambria"
            .Offset(2, -1).Resize(1, 26).Font.Size = 16
        End With
        If i < lngNumPages - 1 Then
            With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, 2)
                .Value = "Previous Total"
                .Font.Bold = True
                .Resize(1, 25).Font.Bold = True
                .Offset(0, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
                .Offset(0, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
                .Offset(0, -1).Resize(1, 26).Font.Name = "Cambria"
                .Offset(0, -1).Resize(1, 26).Font.Size = 16
                .Offset(0, 7).Resize(1, 2).Interior.Color = 10921638
                .Offset(0, 9).Resize(1, 16).Interior.Color = 12379352
                .RowHeight = 65
            End With
        End If
        For c = 9 To 25 Step 2
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c).FormulaR1C1 = "=MOD(SUM(100*SUM(R[-26]C[1]:R[-1]C[1]),R[-26]C:R[-1]C),100)"
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c + 1).FormulaR1C1 = "=INT(SUM(100*SUM(R[-26]C:R[-1]C),R[-26]C[-1]:R[-1]C[-1])/100)"
            If i < lngNumPages - 1 Then
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c).FormulaR1C1 = "=R[-8]C"
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c + 1).FormulaR1C1 = "=R[-8]C"
            End If
        Next c
    Next i

    wshTarget.Cells(6, 1).Resize(1, 26).Borders.LineStyle = xlContinuous
    For i = 0 To lngNumPages - 1
        lngRow = 8 + (lngRowsPerPage + 9) * i
        Debug.Print lngRow
        wshTarget.Cells(lngRow - 1, 1).Resize(lngRowsPerPage + 2, 26).Borders.LineStyle = xlContinuous
    Next i

    wshTarget.Columns("A:Z").AutoFit

    With wshTarget.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .LeftMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .Zoom = 75
        .PrintTitleRows = "$1:$7"
        '.PrintArea = "$A$1:$Z$" & lngLastRow
    End With

    Application.Goto wshTarget.Cells(lngHeaderRowStart, "A")
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
End Sub
Best wishes,
Hans

jakjo
Lounger
Posts: 40
Joined: 28 May 2022, 00:57

Re: Help with code to summing the total of decimal and integer numbers

Post by jakjo »

Thank you very much, Mr. Hans, for this outstanding effort.
When running the code, I noticed a difference in the row height of the last page compared to the rest of the pages.
How can this issue be addressed to ensure the pages are aligned properly when printed?"
Once again, thank you very much

User avatar
HansV
Administrator
Posts: 80088
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Help with code to summing the total of decimal and integer numbers

Post by HansV »

Change the loop

Code: Select all

    For i = 0 To lngNumPages - 1
        lngRow = 8 + (lngRowsPerPage + 9) * i
        wshTarget.Cells(lngRow - 1, 1).Resize(lngRowsPerPage + 2, 26).Borders.LineStyle = xlContinuous
    Next i
to

Code: Select all

    For i = 0 To lngNumPages - 1
        lngRow = 8 + (lngRowsPerPage + 9) * i
        wshTarget.Cells(lngRow - 1, 1).Resize(lngRowsPerPage + 2, 26).Borders.LineStyle = xlContinuous
        wshTarget.Cells(lngRow, 1).Resize(34).RowHeight = 20.25
    Next i
Best wishes,
Hans

jakjo
Lounger
Posts: 40
Joined: 28 May 2022, 00:57

Re: Help with code to summing the total of decimal and integer numbers

Post by jakjo »

Thank you very much, Mr. Hans
Actually, I don't want to burden you, but with this addition, the height of the total row and the previous total row has been changed to 20.25 points.
Is it possible to copy the row heights from the source sheet to the target sheet in such a way that the height of the total rows and the previous total rows remain at 65 points? .... Thank you very much for your patience with me

User avatar
HansV
Administrator
Posts: 80088
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Help with code to summing the total of decimal and integer numbers

Post by HansV »

This should correct the row heights:

Code: Select all

Sub TransferColumns()
    Const lngHeaderRowStart = 6
    Const lngHeaderRowEnd = 7
    Const lngFirstRow = 8
    Const lngRowsPerPage = 25
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim lngLastRow As Long
    Dim lngNumRows As Long
    Dim lngNumPages As Long
    Dim i As Long
    Dim lngRow As Long
    Dim c As Long

    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set wshSource = Worksheets("MasterData") ' ******
    With wshSource
        lngLastRow = .Range("A:AW").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        Set rng1 = .Range("A" & lngFirstRow & ":A" & lngLastRow)
        Set rng2 = .Range("D" & lngFirstRow & ":D" & lngLastRow)
        Set rng3 = .Range("F" & lngFirstRow & ":F" & lngLastRow)
        Set rng4 = .Range("AA" & lngFirstRow & ":AW" & lngLastRow)
    End With

    On Error Resume Next
    Application.DisplayAlerts = False
    
    Worksheets("Abstract").Delete ' ********
    
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set wshTarget = Worksheets.Add(After:=wshSource)
    
    wshTarget.Name = "Abstract" ' **********

    With wshSource
        .Range("A" & lngHeaderRowStart & ":A" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("A" & lngHeaderRowStart)
        .Range("D" & lngHeaderRowStart & ":D" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("B" & lngHeaderRowStart)
        .Range("F" & lngHeaderRowStart & ":F" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("C" & lngHeaderRowStart)
        .Range("AA" & lngHeaderRowStart & ":AW" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("D" & lngHeaderRowStart)
    End With

    With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
        .Font.Name = "Arial"
        .Font.Size = 12
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

    With wshTarget
        .Rows(lngHeaderRowStart).RowHeight = 80
        .Rows(lngHeaderRowStart + 1).RowHeight = 30
    End With

    rng1.Copy Destination:=wshTarget.Cells(lngFirstRow, "A")
    rng2.Copy Destination:=wshTarget.Cells(lngFirstRow, "B")
    rng3.Copy Destination:=wshTarget.Cells(lngFirstRow, "C")
    rng4.Copy Destination:=wshTarget.Cells(lngFirstRow, "D")

    lngNumRows = lngLastRow - lngFirstRow + 1
    lngNumPages = lngNumRows \ lngRowsPerPage
    If lngNumRows Mod lngRowsPerPage > 0 Then
        lngNumPages = lngNumPages + 1
    End If

    For i = lngNumPages - 1 To 0 Step -1
        lngRow = lngFirstRow + lngRowsPerPage * i
        If i > 0 Then
            wshTarget.Range("A" & lngRow).Resize(9).EntireRow.Insert
            wshTarget.HPageBreaks.Add Before:=wshTarget.Range("A" & lngRow + 8)
        End If
        With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), 2)
            .Value = "Total Table"
            .Resize(1, 25).Font.Bold = True
            .Offset(0, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
            .Offset(0, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
            .Offset(0, -1).Resize(1, 26).Font.Name = "Cambria"
            .Offset(0, -1).Resize(1, 26).Font.Size = 16
            .Offset(0, 7).Resize(1, 2).Interior.Color = 10921638
            .Offset(0, 9).Resize(1, 16).Interior.Color = 12379352
            .Offset(2, 0).Value = "First signature"
            .Offset(2, 6).Value = "Second signature"
            .Offset(2, 12).Value = "Third signature"
            .Offset(2, 22).Value = "Fourth signature"
            .Offset(2, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
            .Offset(2, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
            .Offset(2, -1).Resize(1, 26).Font.Name = "Cambria"
            .Offset(2, -1).Resize(1, 26).Font.Size = 16
        End With
        If i < lngNumPages - 1 Then
            With wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, 2)
                .Value = "Previous Total"
                .Font.Bold = True
                .Resize(1, 25).Font.Bold = True
                .Offset(0, -1).Resize(1, 26).HorizontalAlignment = xlHAlignCenter
                .Offset(0, -1).Resize(1, 26).VerticalAlignment = xlVAlignCenter
                .Offset(0, -1).Resize(1, 26).Font.Name = "Cambria"
                .Offset(0, -1).Resize(1, 26).Font.Size = 16
                .Offset(0, 7).Resize(1, 2).Interior.Color = 10921638
                .Offset(0, 9).Resize(1, 16).Interior.Color = 12379352
            End With
        End If
        For c = 9 To 25 Step 2
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c).FormulaR1C1 = "=MOD(SUM(100*SUM(R[-26]C[1]:R[-1]C[1]),R[-26]C:R[-1]C),100)"
            wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0), c + 1).FormulaR1C1 = "=INT(SUM(100*SUM(R[-26]C:R[-1]C),R[-26]C[-1]:R[-1]C[-1])/100)"
            If i < lngNumPages - 1 Then
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c).FormulaR1C1 = "=R[-8]C"
                wshTarget.Cells(lngRow + lngRowsPerPage - 9 * (i > 0) + 8, c + 1).FormulaR1C1 = "=R[-8]C"
            End If
        Next c
    Next i

    wshTarget.Cells(6, 1).Resize(1, 26).Borders.LineStyle = xlContinuous
    For i = 0 To lngNumPages - 1
        lngRow = 8 + (lngRowsPerPage + 9) * i
        wshTarget.Cells(lngRow - 1, 1).Resize(lngRowsPerPage + 2, 26).Borders.LineStyle = xlContinuous
        wshTarget.Cells(lngRow, 1).Resize(34).RowHeight = 20.25
        wshTarget.Cells(lngRow + 25, 1).RowHeight = 65
        If i < lngNumPages - 1 Then
            wshTarget.Cells(lngRow + 33, 1).RowHeight = 65
        End If
    Next i

    wshTarget.Columns("A:Z").AutoFit

    With wshTarget.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .LeftMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .Zoom = 75
        .PrintTitleRows = "$1:$7"
        '.PrintArea = "$A$1:$Z$" & lngLastRow
    End With

    Application.Goto wshTarget.Cells(lngHeaderRowStart, "A")
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
End Sub
Best wishes,
Hans

jakjo
Lounger
Posts: 40
Joined: 28 May 2022, 00:57

Re: Help with code to summing the total of decimal and integer numbers

Post by jakjo »

Thank you very much, Mr. Hans I wish you all the best
There are people who pass through time history must inevitably pause to honor their contributions with reverence and respect To those whose presence illuminated our hearts before their efforts illuminated the places around them.... My regards to you