Help to join 2 sets of data by modifying MACRO into VBA

Dear All,

We need to get data from 2 system and combine them into 1 summary and format the header and do a sum adding.

I had attached a workbook with the MACRO that I had created which some steps that still needs to do manually.

Is it possible to write a VBA and do it in 1 button?

Sub test()
Application.ScreenUpdating = False
With Sheets("Header")
    arr = .Range("B7", "M" & .Range("B" & .Rows.Count).End(xlUp).Row)
    ReDim sn(1 To UBound(arr), 1 To 8)
    For x = 1 To UBound(arr)
        If x = 1 Then
            sn(x, 1) = "No"
            sn(x, 2) = "Invoice"
            sn(x, 3) = "Account Code"
            sn(x, 4) = "Begin Date"
            sn(x, 5) = "End Date"
            sn(x, 6) = "Before GST"
            sn(x, 7) = "Sales Tax"
            sn(x, 8) = "Amount"
        Else
            sn(x, 1) = x - 1
            sn(x, 2) = "00" & arr(x, 1)
            sn(x, 3) = arr(x, 2)
            sn(x, 4) = arr(x, 4)
            sn(x, 5) = arr(x, 5)
            sn(x, 6) = arr(x, 10)
            sn(x, 7) = arr(x, 11)
            sn(x, 8) = arr(x, 12)
        End If
    Next
    mstring = Format(.Range("E8"), "mmmm") & " " & Format(.Range("E8"), "yyyy")
End With
For i = 1 To Sheets.Count
    If Sheets(i).Name = mstring Then
        MsgBox "This month has been created before !"
        Exit Sub
    End If
Next
Sheets.Add After:=Sheets("Header")
ActiveSheet.Name = mstring
With Sheets(mstring)
    .Range("A7").Resize(UBound(sn), 8) = sn
    lr = 6 + UBound(sn)
    .Range("B7", "B" & lr).NumberFormat = "0000000"
    .Range("F8", "H" & lr).NumberFormat = ("$#.##0.00")
    .Range("F" & lr + 1).FormulaR1C1 = "=SUM(R[-14]C:R[-1]C)"
    .Range("F" & lr + 1).AutoFill Destination:=.Range("F" & lr + 1, "H" & lr + 1), Type:=xlFillDefault
    With .Range("A7", "H" & lr).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
     End With
     With .Range("A7", "H" & lr).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Range("A7", "H" & lr).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Range("A7", "H" & lr).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Range("A7", "H" & lr).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Range("A7", "H" & lr).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With .Range("F" & lr + 1, "H" & lr + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
    End With
    .Columns(1).ColumnWidth = 5
    .Columns(2).ColumnWidth = 9
    .Columns(3).ColumnWidth = 14
    .Range("A7", "H7").Font.Bold = True
    Sheets("Header").Range("B1", "B5").Copy .Range("B1")
    .Range("B1:H1").HorizontalAlignment = xlCenterAcrossSelection
    .Range("B2", "B5").Font.Bold = True
    .Range("E2") = "No:"
    .Range("F2") = .Range("B8")
    .Range("G2") = "To"
    .Range("H2") = .Range("B" & lr)
    .Range("G3") = "Date"
    .Range("H3") = .Range("E8")
    .Range("H3").NumberFormat = ("dd/mm/yyyy")
    .Range("F2", "H2").NumberFormat = "0000000"
    Application.Goto .Range("A1"), scroll:=True
End With
End Sub

Kind regards
Leo

Hi
Try

Sub DelColumnD()
    Dim a, b As Variant
    Dim tmp, x
    With Sheets("Header")
        a = .Range("B7").Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 6, 12)
        b = .Range("B1:H5")
    End With
    Application.ScreenUpdating = False
    Worksheets.Add
    ActiveSheet.Name = MonthName(Split(a(2, 3), "/")(1)) & Right(Split(a(2, 3), "/")(2), 2)
    With ActiveSheet
        With .Range("B1:H1")
            .Resize(5, 1) = b
            .HorizontalAlignment = xlCenter
            .Merge
            .Font.Bold = True
            .Resize(5, 1).Font.Name = "Calibri"
            .Resize(5, 1).Font.Size = 10
        End With
        Range("E2") = "No": Range("F2") = a(2, 1)
        Range("G2") = "to": Range("H2") = a(UBound(a), 1)
        Range("G3") = "Date": Range("H3") = a(2, 3)
        .Range("b7").Resize(UBound(a), 7) = Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(1, 2, 4, 5, 10, 11, 12))

        .Range("A7") = "No"
        .Range("A8").Resize(UBound(a) - 1) = Evaluate("Row(1:" & UBound(a, 1) - 1 & ")")
        .Range("F" & 7 + UBound(a)) = WorksheetFunction.Sum(Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(10)))
        .Range("G" & 7 + UBound(a)) = WorksheetFunction.Sum(Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(11)))
        .Range("H" & 7 + UBound(a)) = WorksheetFunction.Sum(Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(12)))
        With .Range("b7").Offset(, -1).Resize(UBound(a), 8)
            With .Resize(1)
                .Font.Bold = True
            End With
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .Font.Name = "Calibri"
            .Font.Size = 10
        End With
        .Range("F" & 7 + UBound(a)).Resize(, 3).Borders(xlEdgeBottom).LineStyle = xlDouble
    End With
    Application.ScreenUpdating = True
End Sub

Originally Posted by mohadin

Hi
Try

Sub DelColumnD()
    Dim a, b As Variant
    Dim tmp, x
    With Sheets("Header")
        a = .Range("B7").Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 6, 12)
        b = .Range("B1:H5")
    End With
    Application.ScreenUpdating = False
    Worksheets.Add
    ActiveSheet.Name = MonthName(Split(a(2, 3), "/")(1)) & Right(Split(a(2, 3), "/")(2), 2)
    With ActiveSheet
        With .Range("B1:H1")
            .Resize(5, 1) = b
            .HorizontalAlignment = xlCenter
            .Merge
            .Font.Bold = True
            .Resize(5, 1).Font.Name = "Calibri"
            .Resize(5, 1).Font.Size = 10
        End With
        Range("E2") = "No": Range("F2") = a(2, 1)
        Range("G2") = "to": Range("H2") = a(UBound(a), 1)
        Range("G3") = "Date": Range("H3") = a(2, 3)
        .Range("b7").Resize(UBound(a), 7) = Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(1, 2, 4, 5, 10, 11, 12))

        .Range("A7") = "No"
        .Range("A8").Resize(UBound(a) - 1) = Evaluate("Row(1:" & UBound(a, 1) - 1 & ")")
        .Range("F" & 7 + UBound(a)) = WorksheetFunction.Sum(Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(10)))
        .Range("G" & 7 + UBound(a)) = WorksheetFunction.Sum(Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(11)))
        .Range("H" & 7 + UBound(a)) = WorksheetFunction.Sum(Application.Index(a, Evaluate("Row(1:" & UBound(a, 1) & ")"), Array(12)))
        With .Range("b7").Offset(, -1).Resize(UBound(a), 8)
            With .Resize(1)
                .Font.Bold = True
            End With
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .Font.Name = "Calibri"
            .Font.Size = 10
        End With
        .Range("F" & 7 + UBound(a)).Resize(, 3).Borders(xlEdgeBottom).LineStyle = xlDouble
    End With
    Application.ScreenUpdating = True
End Sub

Dear Mohadin,

Your code was "too complicated" for me to modify but appreciate your help.

Thanks to both LeoTaxi and mohadin.

I had adopted and do some amendments to LeoTaxi's script but was stuck on how to fixed the row height to 15.5 using LeoTaxi's script.

I had tried few ways to add in a fixed row height script but failed.

Can I fixed a top page margin to 4cm and bold the last row (the sum amount)?

Can someone help?

Originally Posted by LeoTaxi

Sub test()
Application.ScreenUpdating = False
With Sheets("Header")
    arr = .Range("B7", "M" & .Range("B" & .Rows.Count).End(xlUp).Row)
    ReDim sn(1 To UBound(arr), 1 To 8)
    For x = 1 To UBound(arr)
        If x = 1 Then
            sn(x, 1) = "No"
            sn(x, 2) = "Invoice"
            sn(x, 3) = "Account Code"
            sn(x, 4) = "Begin Date"
            sn(x, 5) = "End Date"
            sn(x, 6) = "Before GST"
            sn(x, 7) = "Sales Tax"
            sn(x, 8) = "Amount"
        Else
            sn(x, 1) = x - 1
            sn(x, 2) = "00" & arr(x, 1)
            sn(x, 3) = arr(x, 2)
            sn(x, 4) = arr(x, 4)
            sn(x, 5) = arr(x, 5)
            sn(x, 6) = arr(x, 10)
            sn(x, 7) = arr(x, 11)
            sn(x, 8) = arr(x, 12)
        End If
    Next
    mstring = Format(.Range("E8"), "mmmm") & " " & Format(.Range("E8"), "yyyy")
End With
For i = 1 To Sheets.Count
    If Sheets(i).Name = mstring Then
        MsgBox "This month has been created before !"
        Exit Sub
    End If
Next
Sheets.Add After:=Sheets("Header")
ActiveSheet.Name = mstring
With Sheets(mstring)
    .Rows.RowHeight = 15.5
    .PageSetup.TopMargin = Application.InchesToPoints(1.5748031496063)
    .Range("A7").Resize(UBound(sn), 8) = sn
    lr = 6 + UBound(sn)
    .Range("B7", "B" & lr).NumberFormat = "0000000"
    .Range("F8", "H" & lr).NumberFormat = ("$#.##0.00")
    .Range("F" & lr + 1).FormulaR1C1 = "=SUM(R[-14]C:R[-1]C)"
    .Range("F" & lr + 1).Font.Bold = True
    .Range("F" & lr + 1).AutoFill Destination:=.Range("F" & lr + 1, "H" & lr + 1), Type:=xlFillDefault
    .Range("A7", "H" & lr).Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("A7", "H" & lr).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("A7", "H" & lr).Borders(xlEdgeRight).LineStyle = xlContinuous
    .Range("A7", "H" & lr).Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range("A7", "H" & lr).Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Range("A7", "H" & lr).Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range("F" & lr + 1, "H" & lr + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
    .Cells.Font.Name = "Calibri"
    .Cells.Font.Size = 10
    .Columns(1).ColumnWidth = 5
    .Columns(2).ColumnWidth = 9
    .Columns(3).ColumnWidth = 14
    .Range("A7", "H7").Font.Bold = True
    Sheets("Header").Range("B1", "B5").Copy .Range("B1")
    .Range("B1:H1").HorizontalAlignment = xlCenterAcrossSelection
    .Range("B2", "B5").Font.Bold = True
    .Range("E2") = "No:"
    .Range("F2") = .Range("B8")
    .Range("G2") = "To"
    .Range("H2") = .Range("B" & lr)
    .Range("G3") = "Date"
    .Range("H3") = .Range("E8")
    .Range("H3").NumberFormat = ("dd/mm/yyyy")
    .Range("F2", "H2").NumberFormat = "0000000"
    Application.Goto .Range("A1"), scroll:=True
End With
End Sub

Kind regards
Leo

Dear Leo,

I had amended this section as the addition is not working as my rows will change from time to time.

With Sheets(mstring)
    .Rows.RowHeight = 15.5
    .PageSetup.TopMargin = Application.InchesToPoints(1.5748031496063)
    .Range("A7").Resize(UBound(sn), 8) = sn
    lr = 6 + UBound(sn)
    .Range("B7", "B" & lr).NumberFormat = "0000000"
    .Range("F8", "H" & lr).NumberFormat = ("$##,###.00")
    .Range("F" & lr + 1).AutoFill Destination:=.Range("F" & lr + 1, "H" & lr + 1), Type:=xlFillDefault
    .Range("F" & lr + 1).Font.Bold = True
    .Range("G" & lr + 1).Font.Bold = True
    .Range("H" & lr + 1).Font.Bold = True
    
    LastRow = Range("F8").End(xlDown).Row
    Cells(LastRow + 1, "F").Formula = "=sum(F8:F" & LastRow & ")"
    LastRow = Range("G8").End(xlDown).Row
    Cells(LastRow + 1, "G").Formula = "=sum(G8:G" & LastRow & ")"
        LastRow = Range("H8").End(xlDown).Row
    Cells(LastRow + 1, "H").Formula = "=sum(H8:H" & LastRow & ")"

Thank you for the guidance and the code works great!!