Need to create a comma delimited list based on a complex lookup from another table that could have one to many relationship - VBA

[mweirath]

I have a problem that I am not sure where to even start at, but I am trying to create a VBA solution to my issue. I have two tables I need to compare values against and based on that comparison I have to generate a comma delimited list value.

Here is a sample of the data I am reading in and what I am hoping to get out:

[TABLE="class: grid, width: 700"]
<tbody>[TR]
[TD]Specialty Values[/TD]
[TD]Expected Output[/TD]
[/TR]
[TR]
[TD]Pulmonology[/TD]
[TD]Lung Care, Pulmonology[/TD]
[/TR]
[TR]
[TD]Ambulatory Procedure Center, General Surgery[/TD]
[TD]Surgery[/TD]
[/TR]
[TR]
[TD]Obstetrics/gynecology[/TD]
[TD]Obstetrics & Gynecology, Women's Health[/TD]
[/TR]
[TR]
[TD]General Surgery, Vascular Surgery[/TD]
[TD]Surgery, Vascular Surgery[/TD]
[/TR]
</tbody>[/TABLE]

Reference Table

[TABLE="class: grid, width: 1000"]
<tbody>[TR]
[TD]Specialty[/TD]
[TD]Alias[/TD]
[TD]Inc. W[/TD]
[TD]Inc. X[/TD]
[TD]Inc. Y[/TD]
[TD]Inc. Z[/TD]
[TD]Rollup[/TD]
[/TR]
[TR]
[TD][TABLE="width: 219"]
<tbody>[TR]
[TD="class: xl65"]Ambulatory Surgical Center[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]|Ambulatory Surgery Center|Ambulatory Procedure Center|Surgical Services|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Surgery|[/TD]
[/TR]
[TR]
[TD]General Surgery[/TD]
[TD]|Surgery: General|Surgery, General|Surgery|Surgery - General|Surgery, General|Surgery: General|Spine/Trauma/General|Trauma/General|General Surgery (Non-ABMS)||Surgery- General,Thoracic,Vascular|Hernia Surgery|Gen Surgery|Hepatobiliary Surgery|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Surgery|[/TD]
[/TR]
[TR]
[TD]Ob-Gynecology[/TD]
[TD]|Obestetrics & Gynecology|Obstetrics and Gynecology|Obstetrics & Gynecology|Obstetrics-Gynecology|OB-Gyn|OBGYN|OB/Gyn|OB/GYN|Obstetrics/Gynecology|ABOG|Pediatric and Adolescent Gynecology|Obesetrics & Gynecology|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Obstetrics & Gynecology|Women's Health|[/TD]
[/TR]
[TR]
[TD]Pediatric Surgery[/TD]
[TD]|Pediatric Plastic Surgery|Pediatric Orthopedic Surgery|Pediatric General Surgery|Pediatric Transplant Surgery|Pediatric Transplantation|Pediatric Thoracic Surgery|Pediatric Craniofacial Medicine|Pediatric Cardiothoracic Surgery|Pediatric Orthopaedic Surgery|Pediatric Surgery (Non-ABMS)|Pediatric Transplant Hepatology|Pediatric General and Thoracic Surgery|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Pediatric Surgery|[/TD]
[/TR]
[TR]
[TD]Pulmonary Diseases[/TD]
[TD]|Pulmonology|Pulmonary Disease|Pulmonary|Pulmonary & Critical Care Medicine|Pulmonologist|IM Consultation-Heart & Pulmonary Disease|Pulmonary Medicine|Pulmonary & Critical Care|Pulmonary and Sleep Medicine|pulmonary)|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Lung Care|Pulmonology|[/TD]
[/TR]
[TR]
[TD]Surgery, General Vascular[/TD]
[TD]|Surgery: Vascular|Microvascular Surgery|Surgery- General,Thoracic,Vascular|General Vascular Surgery|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Vascular Surgery|[/TD]
[/TR]
[TR]
[TD]Vascular Surgery[/TD]
[TD]|Specialist/Technologist Cardiovascular - Vascular Specialist|Vascular/Endovascular|Vascular|[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]|Vascular Surgery|[/TD]
[/TR]
</tbody>[/TABLE]

Here is how it works:

• Look first at Specialty Values from primary table
• Next see if that Specialty Value exists in the first column of the reference table "Specialty"
• If it is found add the values in the "Rollup" column to a list
• Next see if that Specialty Value exists in the second column of the reference table "Alias"
  • This is used to handle misspellings or common references to a specialty
  • Value could potentially exist under multiple Specialty/Alias combinations
• If it is found add the values in the "Rollup" column to a list
• Remove any duplicates of values, for example if someone has a specialty of General Surgery and Ambulatory Surgery Center, they would have a rollup of Surgery twice, but it should only be shown once in the comma delimited list
• NOTE: In this example columns 3-6 all have "1"'s in the values. There are some scenarios where they might have a zero, and if so I would need to ignore that row in my lookup.

I am stumped as the best way to approach this problem. Have been able to create VBA code to un-delimit the alias column and create individual rows for each alias value (I am not sure if that is the best approach). Even though I was able to get to that point I haven't been able to get much past a complex Vlookup and just find the first time the value is presented. I haven't been able to figure out how to manage multiple potential values and only displaying a single unique value.

 

[Ombir]

For your first table in Sheet1 and second in Sheet2, try this:

Sub Medical()
Dim rng1        As Range
Dim rng2        As Range
Dim Rng         As Range
Dim cell        As Range
Dim Scell       As Range
Dim dic         As Object
Dim ar          As Variant
Dim sp          As Variant
Dim ws1         As Worksheet
Dim ws2         As Worksheet

Set dic = CreateObject("scripting.dictionary")

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Set rng1 = ws1.Range("A2:A" & ws1.Cells(Rows.Count, 1).End(xlUp).Row)
Set rng2 = ws2.Range("A2:B" & ws2.Cells(Rows.Count, 1).End(xlUp).Row)

For Each cell In rng1
    If InStr(cell, ",") > 0 Then
        ar = Split(cell, ",")
    Else
        ReDim ar(1 To 1)
        ar(1) = cell
    End If
    
    For Each ele In ar
        For Each Rng In rng2.Columns
            For Each Scell In Rng.Cells
                If InStr(1, "|" & Scell & "|", "|" & Trim(ele) & "|", 1) > 0 Then
                    If Application.Sum(ws2.Range("C" & Scell.Row).Resize(, 4)) <> 0 Then
                        sp = Split(ws2.Range("G" & Scell.Row), "|")
                          For Each el In sp
                            If Len(el) > 1 Then dic.Item(el) = vbEmpty
                          Next
                        Exit For
                    End If
                End If
            Next
        Next
    Next
    
    If dic.Count > 0 Then
        cell.Offset(, 1) = Replace(Join(dic.keys(), ", "), "|", "")
    ElseIf dic.Count = 1 Then
        cell.Offset(, 1) = Replace(dic.keys()(0), "|", "")
    End If
    dic.RemoveAll
Next
End Sub

Regards,
Ombir

 

[Ombir]

I used the below part of code for another approach. Now its not necessary.

Replace below part:

If dic.Count > 0 Then
    cell.Offset(, 1) = Replace(Join(dic.keys(), ", "), "|", "")
ElseIf dic.Count = 1 Then
    cell.Offset(, 1) = Replace(dic.keys()(0), "|", "")
End If

with this :

cell.Offset(, 1) = Join(dic.keys(), ", ")

 

[mweirath]

I don't care what you think of me! Unless you think I'm awesome – in which case, you're right! Carry on :wink:

Ombir,

I do have to concur you are quite awesome. Thank you so much for your help with this. I modified it slightly so that it would run against my production data and it seems to be working. I am going to have to do some research to better understand what is happening and do some testing to make sure I am getting back all the values I am expecting.

Thank you so much,
Matt

 

[Ombir]

Ombir,

I do have to concur you are quite awesome. Thank you so much for your help with this. I modified it slightly so that it would run against my production data and it seems to be working. I am going to have to do some research to better understand what is happening and do some testing to make sure I am getting back all the values I am expecting.

Thank you so much,
Matt

Thanks for the feedback. You're welcome.