VBA in excel

[prince]

Hello sir, I hope you are doing well.
I need your support for VBA code. In this code for column i (subtotal) i need a value of column H (Total).
But the thing is all columns are based on column A (invoice no.) If any invoice no. is repeated then i want the subtotal of that invoices also.
ex:
column A Column H Column I
101 $40 $40
102 $50 $80
102 $30 $80
103 $20 $20

102 in column A if repeated then subtotal 50+30=80 in shown in column I that is getting from column H.
Output sample sheet attached that i need by VBA code
In Data sheet Data & VBA Code is available.
Thank you for your support and attention.
With regards
Prince

[HansV]

There is no need to use VBA for this - it can easily be done with formulas.

Data Sheet.xlsx

[prince]

Dear Sir,

Everything is functioning flawlessly, but I find myself in need of a VBA code. The reason for this request is that I receive 10-15 sheets on a daily basis, and manually applying a formula to each sheet has become a challenging task. I would greatly appreciate your assistance in creating a VBA code for this purpose.

Thank you and best regards
Prince

[HansV]

Here you go.

Code: Select all

Sub CreateWorkingSheet()
    Dim wsSource As Worksheet
    Dim wsWorking As Worksheet

    Application.ScreenUpdating = False

    ' Set references to the source and working sheets
    Set wsSource = ThisWorkbook.Sheets("Delivery Details")
    On Error Resume Next
    Set wsWorking = ThisWorkbook.Sheets("Working Sheet")
    On Error GoTo 0

    ' Check if Working Sheet exists, create it if not
    If wsWorking Is Nothing Then
        Set wsWorking = ThisWorkbook.Sheets.Add
        wsWorking.Name = "Working Sheet"
    Else
        wsWorking.Cells.Clear
    End If

    ' Copy columns A to G from source to working sheet
    wsSource.Range("A:G").Copy wsWorking.Range("A1")

    ' Add column headers H to O
    wsWorking.Range("H1:O1").Value = Array("TOTAL", "SUBTOTAL", _
        "PAID", "FB#", "SCAC", "PROBIL NO", "INV DATE", "NOTES")

    ' Find the last row in the working sheet
    LastRow = wsWorking.Cells(Rows.Count, 1).End(xlUp).Row

    ' Formulas
    wsWorking.Range("H2").Resize(LastRow - 1).Formula = "=E2+G2"
    wsWorking.Range("I2").Resize(LastRow - 1).Formula = _
        "=SUMIFS(H$2:H$" & LastRow & ",A$2:A$" & LastRow & ",A2)"
    wsWorking.Range("H2:I" & LastRow).NumberFormat = _
        wsWorking.Range("E2").NumberFormat

    Application.ScreenUpdating = True
End Sub

[prince]

Thank you so much sir for your support. It's working perfectly. Hats off to you sir.


With regards
Prince

[prince]

Mr. Hans I need one more edition in this code. In 1st column A (Invoice no.) it can be available some blank cells also.
In this case rest of the data is not showing on the new sheet (Working sheet). I want all data from sheet A to B.
Thank you for your attention.
With regards
Prince

[HansV]

Change the line

Code: Select all

    LastRow = wsWorking.Cells(Rows.Count, 1).End(xlUp).Row

to

Code: Select all

    LastRow = wsWorking.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

[prince]

Thank you so much sir for your support and time.

[prince]

sir, there is one error in this code. when column A has no value. then subtotal showing 0.
kindly help to sort out this error.

Is this macro code compatible with office 365 also?

With regards
Prince

[HansV]

What should it be in your example? $187.00 ?

[HansV]

If it should indeed be $187.00, change the lines

Code: Select all

    wsWorking.Range("I2").Resize(LastRow - 1).Formula = _
        "=SUMIFS(H$2:H$" & LastRow & ",A$2:A$" & LastRow & ",A2)"

to

Code: Select all

    wsWorking.Range("I2").Resize(LastRow - 1).Formula = _
        "=SUMIFS(H$2:H$" & LastRow & ",A$2:A$" & LastRow & ",IF(A2="""",""="",A2))"

[prince]

If the invoice number is empty then the subtotal should remain the same as the total column. It should not be PLUS.

[HansV]

In that case, use

Code: Select all

    wsWorking.Range("I2").Resize(LastRow - 1).Formula = _
        "=IF(A2="""",H2,SUMIFS(H$2:H$" & LastRow & ",A$2:A$" & LastRow & ",A2))"

[prince]

Yes, It's working perfectly as per my requirements.
Thank you so much sir for your valuable time & support.
with warm regards
Prince