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

 

[richh]

Hi dss,

Is there a reason you can't use VLOOKUP on Sheet 2? Or, better yet, a pivot table? A pivot table would make what you're attempting to accomplish a breeze.

 

[dss28]

Hi dss,

Is there a reason you can't use VLOOKUP on Sheet 2? Or, better yet, a pivot table? A pivot table would make what you're attempting to accomplish a breeze.

will vlookup be able to add the cell values i intend to have

 

[richh]

In sheet2, I would first get a list of distinct patient IDs. Then, use VLOOKUP to get the contact info. Use a SUMIF formula to get the sum of the fees paid IF the ID's match.

 

[dss28]

is there any way to build up the pivot table through vba code

In sheet2, I would first get a list of distinct patient IDs. Then, use VLOOKUP to get the contact info. Use a SUMIF formula to get the sum of the fees paid IF the ID's match.

 

[richh]

Not sure how to create a pivot table via code, to be honest. The pivot table you appear to need wouldn't be hard to build manually, given you only need two columns. I would put ID and Contact as row values and Fees Paid as a Value. Then, format the Fees Paid to be SUM rather than count and viola - you have a piivot table in about 2 minutes of work that will update as you populate your data table.

 

[dss28]

In sheet2, I would first get a list of distinct patient IDs. Then, use VLOOKUP to get the contact info. Use a SUMIF formula to get the sum of the fees paid IF the ID's match.

I will rather choose a vba based approach over the pivot table one.
1. how to dig out distinct patient ID without repeating / duplicating. Any function in excel which can be used?

 

[Peter_SSs]

You have not said what, if anything is on Sheet2 and if there is anything whether it should get deleted or added to.
I have assumed that Sheet2 exists but has nothing on it.

Just one other issue: Is it possible that the same ID number could have different contact numbers on different rows in Sheet1? If so, what should happen with that ID on Sheet2?
If that can happen, the code below would keep the contact numbers that is last encountered down the rows of Sheet1.

Test with a copy of your workbook.

Sub CollateFees()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    a = .Range("B1", .Range("E" & Rows.Count).End(xlUp)).Value2
  End With
  d(a(1, 1)) = a(1, 3) & ";" & a(1, 4)
  For i = 2 To UBound(a)
    d(a(i, 1)) = a(i, 3) & ";" & Val(Mid(d(a(i, 1)), InStr(1, d(a(i, 1)) & ";", ";") + 1)) + a(i, 4)
  Next i
  With Sheets("Sheet2").Range("B1:C1").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

 

[dss28]

You have not said what, if anything is on Sheet2 and if there is anything whether it should get deleted or added to.
I have assumed that Sheet2 exists but has nothing on it.

Just one other issue: Is it possible that the same ID number could have different contact numbers on different rows in Sheet1? If so, what should happen with that ID on Sheet2?
If that can happen, the code below would keep the contact numbers that is last encountered down the rows of Sheet1.

Test with a copy of your workbook.

Sub CollateFees()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    a = .Range("B1", .Range("E" & Rows.Count).End(xlUp)).Value2
  End With
  d(a(1, 1)) = a(1, 3) & ";" & a(1, 4)
  For i = 2 To UBound(a)
    d(a(i, 1)) = a(i, 3) & ";" & Val(Mid(d(a(i, 1)), InStr(1, d(a(i, 1)) & ";", ";") + 1)) + a(i, 4)
  Next i
  With Sheets("Sheet2").Range("B1:C1").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

thanks
tried but giving error (Run time error 13, type mismatch) at line
d(a(i, 1)) = a(i, 3) & ";" & Val(Mid(d(a(i, 1)), InStr(1, d(a(i, 1)) & ";", ";") + 1)) + a(i, 4)

 

[Peter_SSs]

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