VBA Question - VBA for validating value from multiple cells/column and fetching value another sheet's cell and pasting it another cell of sheet

[rsolanki]

Hello All,

I am new to VBA and i am working on one personal project, I tried googling my query but haven't found any solution.

I have one Table consisting Name of Doctors, Services they provided, Amount that we collected for their service and type of patient. In another sheet we have percentage which doctor should be getting for their service but it is based on few criteria such as "If Dr. ABC perform Service 1 for Patient Type A than he will get 50 and if Dr. ABC perform Service 1 for Patient Type B then he will get 100" or "If Dr. XYZ perform Service 1 for Patient Type A than he will get 60 and if Dr. XYZ perform service 1 for patient type B then he will get 80" Please refer to below sheets to undersand the what exactly i am trying to achieve.

Sheet 1:

Doctor Name	Name of Service	Service Amount	Patient Type
Dr. ABC	Service 1	100	Type A
Dr. XYZ	Service 2	200	Type B
Dr. EFG	Service 3	300	Type A
Dr. XYZ	Service 1	100	Type A
Dr. ABC	Service 1	100	Type B

Sheet 2:

Doctor Name	Services	Patient Type	Doctor Percentage
Dr. ABC	Service 1	Type A	50​
Dr. ABC	Service 1	Type B	100​
Dr. ABC	Service 2	Type A	60​
Dr. ABC	Service 2	Type B	80​
Dr. ABC	Service 3	Type A	40​
Dr. ABC	Service 3	Type B	70​
Dr. XYZ	Service 1	Type A	40​
Dr. XYZ	Service 1	Type B	60​
Dr. XYZ	Service 2	Type A	70​
Dr. XYZ	Service 2	Type B	100​
Dr. XYZ	Service 3	Type A	50​
Dr. XYZ	Service 3	Type B	80​

Now i am looking for VBA Macro which can search for Specific Doctor Name, Service and Patient Type and Insert Doctor Percent in last column of Sheet1

End Result

Doctor Name	Name of Service	Service Amount	Patient Type	Doctor Percentage
Dr. ABC	Service 1	100	Type A	50​
Dr. XYZ	Service 2	200	Type B	100​
Dr. EFG	Service 3	300	Type A	50​
Dr. XYZ	Service 1	100	Type A	40​
Dr. ABC	Service 1	100	Type B	100​

Please note: Above given are example, actually there are too many Columns and Rows but I am trying to learn and implement this Macro in my excel to automate the task.

Thanks in advance

R Solanki

 

[Kaper]

The easy way will be by:
Use XLOOKUP inside VBA as you would go in a workbook. To have it speed optimized, I load both input and output data tables into arrays, do all operations on arrays stored in memory, and finally write array back to a workbook.

Sub FillColEBasedOnSheet2()
Dim params_for_percentage As Variant, percentage As Variant, input_data As Variant
Dim output_data As Variant, treatment_details As Variant, i As Long, lr As Long
With Sheets("Sheet2")
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  input_data = .Range("A2:D" & lr).Value
  ReDim params_for_percentage(1 To lr - 1)
  ReDim percentage(1 To lr - 1)
  For i = 1 To lr - 1
    params_for_percentage(i) = input_data(i, 1) & ";" & input_data(i, 2) & ";" & input_data(i, 3)
    percentage(i) = input_data(i, 4)
  Next i
End With
With Sheets("Sheet1")
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  output_data = .Range("A2:E" & lr).Value 'note that column E is empty at the beginning
  For i = 1 To lr - 1
    output_data(i, 5) = WorksheetFunction.XLookup(output_data(i, 1) & ";" & output_data(i, 2) & ";" & output_data(i, 4), params_for_percentage, percentage, "N/A", 0)
  Next i
  .Range("A2:E" & lr).Value = output_data
End With
End Sub

 

[Kaper]

Just in case - my test file screenshot to make fitting code to your data easier. Note that last row in both sheets is calculated automatically (I assumend that there is no other content in cells below tables in both sheets