Please provide VBA code

[charnaliaamit]

Hi

I request you to please provide me a code that provide the following solution as per the below query

I am using Excel 2007, I want the code for the following sheet profile, have two sheet in one work sheet, for eg. first sheet contain this data as shown below

S.No.	Bill No.	Doctor Name	Chemist Name	Medicine Name	Quantity	Unit	Rate	Amount	Discount Rate	Discount	Tax Rate	Tax	Net Amount
1	102	1	a	Cok-10	1	Pcs	10	10	5%	1	5	45	54
2	103	2	b	sunwin	1	Pc	18	20	5%	1	5	95	114
3	104	3	a	Cok-10	2	cap	10	40	5%	2	5	190	228
4	105	4	d	coziwin	3	Pc	20	60	5%	3	5	285	342
5	106	5	a	sunwin	4	Pcs	10	50	5%	3	5	235	282
6	107	6	b	Cok-10	7	cap	25	175	5%	9	5	830	996
7	108	7	a	coziwin	8	Pc	10	70	5%	4	5	330	396
8	109	8	b	sunwin	9	Pcs	30	90	5%	5	5	425	510
9	110	9	d	coziwin	12	Pc	29	100	5%	5	5	475	570
10	111	10	a	sunwin	34	cap	10	340	5%	17	5	1615	1938
11	112	11	b	Cok-10	25	Pc	16	300	5%	15	5	1425	1710
12	113	12	c	coziwin	15	Pcs	18	200	5%	10	5	950	1140
13	114	13	a	sunwin	16	cap	19	304	5%	15	5	1445	1734
14	115	14	c	Cok-10	18	Pcs	10	23	5%	1	5	110	132
15	116	15	a	coziwin	20	Pc	13	260	5%	13	5	1235	1482

<TBODY>
</TBODY>

and iind sheet contain

Doctor Name

,

Net Amount

<TBODY>
</TBODY>

Now i want that code which provide me total of net amount by doctor name in iind sheet, I previously post this Query but no one provide me the code, i Know this will solve by pivot table, but it is very happier to me if i got VBA Code, I need this code due to some reasons


Thanks in Advance

 

[b.downey]

You are right, the problem can be easily resolved via a Pivot table, but you asked for code and here it is.

The Code assumes that the Data as you describe is in "Sheet1" and also assumes that there is a second sheet called "Result" that will contain the results

Here is the code:

Option Explicit
Type TypeRec
    Name As String
    Net As Long
End Type
Sub ProcessYTD()
    Const ResultSheetName As String = "Result"
    Dim Wb As Workbook
    Dim Ws As Worksheet
    
    Dim WsResult As Worksheet
    
    Dim RowNo As Long
    Dim Rec() As TypeRec
    Dim IDX As Long
    Dim strName As String
    
    ReDim Rec(0)
    
    Set Wb = ThisWorkbook
    Set WsResult = Wb.Sheets(ResultSheetName)
    Set Ws = Wb.Sheets("Sheet1")
    For RowNo = 2 To Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row - 1
        IDX = FindIdx(Rec, Trim(Ws.Cells(RowNo, "C")))
        Rec(IDX).Net = Rec(IDX).Net + Val(Ws.Cells(RowNo, "N"))
    Next RowNo
    
    WsResult.Cells.ClearContents
    WsResult.Cells(1, "A") = "Name"
    WsResult.Cells(1, "B") = "Net"
    
    For IDX = 1 To UBound(Rec)
        WsResult.Cells(IDX + 1, "A") = Rec(IDX).Name
        WsResult.Cells(IDX + 1, "B") = Rec(IDX).Net
    Next IDX
    WsResult.Activate
    
    MsgBox "Complete", vbInformation
End Sub

Function FindIdx(Rec() As TypeRec, ByVal strName As String) As Long
    Dim IDX As Long
    For IDX = 1 To UBound(Rec)
        If strName = Rec(IDX).Name Then
            FindIdx = IDX
            Exit Function
        End If
    Next IDX
    
    ReDim Preserve Rec(IDX)
    Rec(IDX).Name = strName
    FindIdx = IDX
End Function