look up cell values in one column and add corresponding row values in other column

[dss28]

My Sheet1 contains data of which column B contains patient IDs, Column C - Date, column D - Contact No, Column E - fees paid on various number of days / visits.
I want to gather data of sheet1 to sheet2 where column B will contain patient ID, Column C- contact No. and Column D - total fees paid by the patient so far in one row.

how to build up the vba code

 

[dss28]

The code worked for my sample data so I presume there must be something different about your data.
Here is mine, perhaps you could provide a small sample of yours with XL2BB?

dss28.xlsm
	A	B	C	D	E
1		ID	Date	Contact No	Fees
2		ID1		Num for ID1	68
3		ID2		Num for ID2	92
4		ID1		Num for ID1	60
5		ID2		Num for ID2	82
6		ID3		Num for ID3	62
7		ID4		Num for ID4	91
8		ID3		Num for ID3	75
9		ID3		Num for ID3	51
10		ID3		Num for ID3	81
11		ID3		Num for ID3	92
12		ID3		Num for ID3	63
13		ID4		Num for ID4	69
14
Sheet1

.. and results of the code:

dss28.xlsm
	A	B	C	D
1		ID	Contact No	Fees
2		ID1	Num for ID1	128
3		ID2	Num for ID2	174
4		ID3	Num for ID3	424
5		ID4	Num for ID4	160
6
Sheet2

Good morning,

I realized my mistake as I had altered the file, Your code is working fine with these columns from A to E. Thanks....

I modified the code as I had to include other details of the patient and now the columns I need to capture are:
B - Patient ID
C -
D -
E -
F -
U - fees paid

I tried to modify the code given by you as follows. It captures all the data in the columns B to E, it also captures the fees paid from column U but where ever the patient ID is repeating the total fees paid is not summed up, but picks only the last row details:

the code is :

Sub CollateFees2()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    a = .Range("B1", .Range("U" & Rows.Count).End(xlUp)).Value2
  End With
  d(a(1, 1)) = a(1, 2) & ";" & a(1, 3) & ";" & a(1, 4) & ";" & a(1, 5) & ";" & a(1, 20)
  
  For i = 2 To UBound(a)
    
    d(a(i, 1)) = a(i, 2) & ";" & a(i, 3) & ";" & a(i, 4) & ";" & a(i, 5) & ";" & Val(Mid(d(a(i, 1)), InStr(1, d(a(i, 1)) & ";", ";") + 1)) + a(i, 20)
    
  Next i
  With Sheets("Sheet2").Range("B2:G2").Resize(d.Count)
    .Value = Application.Transpose(Array(d.Keys, d.Items))
    .Columns(2).TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
  End With
End Sub

 

[Peter_SSs]

So, as I mentioned in my last post ..

perhaps you could provide a small sample of yours with XL2BB?

.. and include the expected results

 

[dss28]

So, as I mentioned in my last post ..

.. and include the expected results

The code given by perfectly worked which summed up the fees paid by a patient on number of occasions, however the code i modified further had the issue as said above.

I am attaching the files as suggested. thanks again for patiently helping me.

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	Sr.No.	Patient ID	Name	Address	Contact No.	Alternate No.	G heading	H heading	Iheading	J heading	k heading	L heading	M heading	N heading	O heading	P heading	Q heading	R heading	S heading	T heading	Fees Paid
2	1	2021-001	ABC	BD	111	1111															100
3	2	2021-002	CDE	CD	222	2222															250
4	3	2021-003	DEF	DE	333	3333															250
5	4	2021-004	EFG	EF	444	4444															100
6	5	2021-005	FGH	FG	555	5555															75
7	6	2021-006	GHI	GH	666	6666															175
8	7	2021-007	HIJ	HI	777	7777															200
9	8	2021-002	CDE	CD	222	2222															300
10	9	2021-006	GHI	GH	666	6666															200
11	10	2021-008	IJK	IJ	888	8888															300
12	11	2021-009	JKL	JK	999	9999															250
13	12	2021-005	FGH	FG	555	5555															250
14	13	2021-001	ABC	BD	111	1111															300
15	14	2021-002	CDE	CD	222	2222															250
16	15	2021-009	JKL	JK	999	9999															150
17	16	2021-006	GHI	GH	666	6666															150
18	17	2021-008	IJK	IJ	888	8888															200
19	18	2021-009	JKL	JK	999	9999															125
20	19	2021-007	HIJ	HI	777	7777															125
21	20	2021-010	LMN	LM	1010	101010															150
22	21	2021-010	LMN	LM	1010	101010															200
23	22	2021-001	ABC	BD	111	1111															200
24	23	2021-009	JKL	JK	999	9999															75
25	24	2021-002	CDE	CD	222	2222															400
26	25	2021-008	IJK	IJ	888	8888															75
27	26	2021-007	HIJ	HI	777	7777															75
28	27	2021-006	GHI	GH	666	6666															100
29	28	2021-007	HIJ	HI	777	7777															200
30	29	2021-005	FGH	FG	555	5555															300
31	30	2021-003	DEF	DE	333	3333															200
32
Sheet1

sheet 2 - end result expected

Book1
	B	C	D	E	F	G	H
1	Sr.No.	Patient ID	Name	Address	Contact No.	Alternate No.	Fees Paid
2	1	2021-001	ABC	BD	111	1111	600
3	2	2021-002	CDE	CD	222	2222	1200
4	3	2021-003	DEF	DE	333	3333	450
5	4	2021-004	EFG	EF	444	4444	100
6	5	2021-005	FGH	FG	555	5555	625
7	6	2021-006	GHI	GH	666	6666	625
8	7	2021-007	HIJ	HI	777	7777	600
9	10	2021-008	IJK	IJ	888	8888	575
10	11	2021-009	JKL	JK	999	9999	600
11	20	2021-010	LMN	LM	1010	101010	350
Sheet2

 

[dss28]

The code given by perfectly worked which summed up the fees paid by a patient on number of occasions, however the code i modified further had the issue as said above.

I am attaching the files as suggested. thanks again for patiently helping me.

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	Sr.No.	Patient ID	Name	Address	Contact No.	Alternate No.	G heading	H heading	Iheading	J heading	k heading	L heading	M heading	N heading	O heading	P heading	Q heading	R heading	S heading	T heading	Fees Paid
2	1	2021-001	ABC	BD	111	1111															100
3	2	2021-002	CDE	CD	222	2222															250
4	3	2021-003	DEF	DE	333	3333															250
5	4	2021-004	EFG	EF	444	4444															100
6	5	2021-005	FGH	FG	555	5555															75
7	6	2021-006	GHI	GH	666	6666															175
8	7	2021-007	HIJ	HI	777	7777															200
9	8	2021-002	CDE	CD	222	2222															300
10	9	2021-006	GHI	GH	666	6666															200
11	10	2021-008	IJK	IJ	888	8888															300
12	11	2021-009	JKL	JK	999	9999															250
13	12	2021-005	FGH	FG	555	5555															250
14	13	2021-001	ABC	BD	111	1111															300
15	14	2021-002	CDE	CD	222	2222															250
16	15	2021-009	JKL	JK	999	9999															150
17	16	2021-006	GHI	GH	666	6666															150
18	17	2021-008	IJK	IJ	888	8888															200
19	18	2021-009	JKL	JK	999	9999															125
20	19	2021-007	HIJ	HI	777	7777															125
21	20	2021-010	LMN	LM	1010	101010															150
22	21	2021-010	LMN	LM	1010	101010															200
23	22	2021-001	ABC	BD	111	1111															200
24	23	2021-009	JKL	JK	999	9999															75
25	24	2021-002	CDE	CD	222	2222															400
26	25	2021-008	IJK	IJ	888	8888															75
27	26	2021-007	HIJ	HI	777	7777															75
28	27	2021-006	GHI	GH	666	6666															100
29	28	2021-007	HIJ	HI	777	7777															200
30	29	2021-005	FGH	FG	555	5555															300
31	30	2021-003	DEF	DE	333	3333															200
32
Sheet1

sheet 2 - end result expected

Book1
	B	C	D	E	F	G	H
1	Sr.No.	Patient ID	Name	Address	Contact No.	Alternate No.	Fees Paid
2	1	2021-001	ABC	BD	111	1111	600
3	2	2021-002	CDE	CD	222	2222	1200
4	3	2021-003	DEF	DE	333	3333	450
5	4	2021-004	EFG	EF	444	4444	100
6	5	2021-005	FGH	FG	555	5555	625
7	6	2021-006	GHI	GH	666	6666	625
8	7	2021-007	HIJ	HI	777	7777	600
9	10	2021-008	IJK	IJ	888	8888	575
10	11	2021-009	JKL	JK	999	9999	600
11	20	2021-010	LMN	LM	1010	101010	350
Sheet2

please refer this sheet 2

Book1
	B	C	D	E	F	G
1	Patient ID	Name	Address	Contact No.	Alternate No.	Fees Paid
2	2021-001	ABC	BD	111	1111	600
3	2021-002	CDE	CD	222	2222	1200
4	2021-003	DEF	DE	333	3333	450
5	2021-004	EFG	EF	444	4444	100
6	2021-005	FGH	FG	555	5555	625
7	2021-006	GHI	GH	666	6666	625
8	2021-007	HIJ	HI	777	7777	600
9	2021-008	IJK	IJ	888	8888	575
10	2021-009	JKL	JK	999	9999	600
11	2021-010	LMN	LM	1010	101010	350
Sheet2

 

[Peter_SSs]

I am attaching the files as suggested.

Thanks, that makes it much clearer.
With the extra columns, I'd take a modified approach. See if this is closer to the mark.

Sub CollateFees_v2()
  Dim d As Object
  Dim a As Variant, aRws As Variant
  Dim i As Long
  Dim s As String
  
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    aRws = Evaluate("Row(1:" & .Range("A" & Rows.Count).End(xlUp).Row & ")")
    a = Application.Index(.Cells, aRws, Array(2, 3, 4, 5, 6, 21))
  End With
  For i = 1 To UBound(a)
    s = Join(Application.Index(a, i, Array(1, 2, 3, 4, 5)), ";")
    If d.exists(s) Then
      d(s) = d(s) + a(i, 6)
    Else
      d(s) = a(i, 6)
    End If
  Next i
  With Sheets("Sheet2")
    With .Range("B1").Resize(d.Count)
      .Value = Application.Transpose(d.Keys)
      .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    End With
    .Range("G1").Resize(d.Count).Value = Application.Transpose(d.Items)
    .UsedRange.Columns.AutoFit
  End With
End Sub

 

[dss28]

Thanks, that makes it much clearer.
With the extra columns, I'd take a modified approach. See if this is closer to the mark.

Sub CollateFees_v2()
  Dim d As Object
  Dim a As Variant, aRws As Variant
  Dim i As Long
  Dim s As String
 
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    aRws = Evaluate("Row(1:" & .Range("A" & Rows.Count).End(xlUp).Row & ")")
    a = Application.Index(.Cells, aRws, Array(2, 3, 4, 5, 6, 21))
  End With
  For i = 1 To UBound(a)
    s = Join(Application.Index(a, i, Array(1, 2, 3, 4, 5)), ";")
    If d.exists(s) Then
      d(s) = d(s) + a(i, 6)
    Else
      d(s) = a(i, 6)
    End If
  Next i
  With Sheets("Sheet2")
    With .Range("B1").Resize(d.Count)
      .Value = Application.Transpose(d.Keys)
      .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    End With
    .Range("G1").Resize(d.Count).Value = Application.Transpose(d.Items)
    .UsedRange.Columns.AutoFit
  End With
End Sub

Excellent..... so quick ......
you are truly genius ...

will have to go word by word to understand and learn this amazing coding....

thanks a lot Peter_SSs

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.