Macro to Find Two Columns

[miva0601]

I receive a file each month where I need to do a find and replace on two columns.
I highlight both columns and find and replace
find "_GUAR" replace all with nothing
find"," replace all with a space
find "HEALTHMART" replace all with HM
find "HEALTH MART" replace all with HM

Here's what the data looks like when I receive it (before I do the above operations)

Preliminary 202109 TPR.xlsm
	BG	BH
1	Waivers	Missed Criteria
78	GPR_GUAR,HEALTHMART	GPR
125	GPR_GUAR,BPR_GUAR,BPR_GUAR	#
136	GPR_GUAR,BPR_GUAR,HEALTHMART	BPR
137	GPR_GUAR,BPR_GUAR,HEALTHMART	#
163	BPR_GUAR	BPR
164	GPR_GUAR,BPR_GUAR,HEALTHMART	BPR,GPR
177	HEALTHMART	HEALTHMART
254	GPR_GUAR	GPR
269	GPR_GUAR,BPR_GUAR,BPR_GUAR	BPR,GPR
272	BPR_GUAR	BPR
309	GPR_GUAR	GPR
332	BPR_GUAR	#
345	BPR_GUAR	#
390	BPR_GUAR	#
420	GPR_GUAR	GPR
440	HEALTHMART,GPR_GUAR	GPR
451	GPR_GUAR,HEALTHMART	GPR
467	HEALTHMART	HEALTHMART
490	GPR_GUAR,BPR_GUAR,BPR_GUAR	BPR,GPR,HEALTHMART
494	BPR_GUAR	BPR
576	GPR_GUAR,BPR_GUAR,BPR_GUAR	BPR,GPR
580	BPR_GUAR	BPR
New

After I do the above listed operations, the data looks like the below.

Preliminary 202109 TPR.xlsm
	BG	BH
1	Waivers	Missed Criteria
78	GPR HM	GPR
125	GPR BPR BPR	#
136	GPR BPR HM	BPR
137	GPR BPR HM	#
163	BPR	BPR
164	GPR BPR HM	BPR GPR
177	HM	HM
254	GPR	GPR
269	GPR BPR BPR	BPR GPR
272	BPR	BPR
309	GPR	GPR
332	BPR	#
345	BPR	#
390	BPR	#
420	GPR	GPR
New

At this point, I need to put each cell in alphabetical order and no repeats (not sort the entire column, but the cell, so basically row 269 has GPR BPR BPR and it needs to be BPR GPR), so that ultimately I can add a column with an IF formula that would look at each row and if the two columns match it would say "All Passed")
Here's what final data should look like

Preliminary 202109 TPR.xlsm
	BG	BH
1	Waivers	Missed Criteria
78	GPR HM	GPR
125	BPR GPR	#
136	BPR GPR HM	BPR
137	GPR BPR HM	#
163	BPR	BPR
164	BPR GPR HM	BPR GPR
177	HM	HM
254	GPR	GPR
269	BPR GPR	BPR GPR
272	BPR	BPR
309	GPR	GPR
332	BPR	#
345	BPR	#
390	BPR	#
420	GPR	GPR
440	GPR HM	GPR
451	GPR HM	GPR
467	HM	HM
New

A couple of notes:
The column headers will never change and it will always be column BG and BH
The number of rows does change each month
'#' no action for this, I later just delete this and the cell will be blank
Some months, the Missed Criteria will also have "GCR" which I'd like to put in alphabetical order, so it'd be great if the code allowed for this. Example Missed Criteria column has BPR GPR HM GCR should be BPR GCR GPR HM

Thank you in advance

 

[miva0601]

The most time is consumed by using the Replace function on the sheet. I use the replace function but in memory.
Now the execution is immediate:

Sub replace_on_two_columns_2()
  Dim a As Variant
  Dim i As Long
  Application.ScreenUpdating = False
  With ActiveSheet.Range("BG2:BH" & ActiveSheet.Range("BG" & Rows.Count).End(3).Row)
    a = .Value
      ReDim b(1 To UBound(a, 1), 1 To 2)
      For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
          b(i, 1) = finaldata_2(replacedata(a(i, 1)))
        End If
        If a(i, 2) <> "" Then
          b(i, 2) = finaldata_2(replacedata(a(i, 2)))
        End If
      Next
    .Value = b
  End With
End Sub

Function replacedata(data)
  data = Replace(Replace(data, "_GUAR", "", , , vbTextCompare), ",", " ")
  data = Replace(data, "HEALTHMART", "HM", , , vbTextCompare)
  replacedata = Replace(data, "HEALTH MART", "HM", , , vbTextCompare)
End Function

Function finaldata_2(data)
  Dim a As Variant, itm As Variant
  Dim valores As New Collection
  Dim bex As Boolean
  Dim i As Long

  For Each itm In Split(data, " ")
    bex = False
    For i = 1 To valores.Count
      Select Case StrComp(valores(i), itm, vbTextCompare)
        Case 0
          bex = True
          Exit For
        Case 1
          bex = True
          valores.Add itm, itm, Before:=i
          Exit For
      End Select
    Next
    If bex = False Then valores.Add itm, itm
  Next
  ReDim a(1 To valores.Count)
  For i = 1 To valores.Count
    a(i) = valores(i)
  Next
  finaldata_2 = Join(a, " ")
End Function

You are my hero. I can't thank you enough!

 

[miva0601]

The most time is consumed by using the Replace function on the sheet. I use the replace function but in memory.
Now the execution is immediate:

Sub replace_on_two_columns_2()
  Dim a As Variant
  Dim i As Long
  Application.ScreenUpdating = False
  With ActiveSheet.Range("BG2:BH" & ActiveSheet.Range("BG" & Rows.Count).End(3).Row)
    a = .Value
      ReDim b(1 To UBound(a, 1), 1 To 2)
      For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
          b(i, 1) = finaldata_2(replacedata(a(i, 1)))
        End If
        If a(i, 2) <> "" Then
          b(i, 2) = finaldata_2(replacedata(a(i, 2)))
        End If
      Next
    .Value = b
  End With
End Sub

Function replacedata(data)
  data = Replace(Replace(data, "_GUAR", "", , , vbTextCompare), ",", " ")
  data = Replace(data, "HEALTHMART", "HM", , , vbTextCompare)
  replacedata = Replace(data, "HEALTH MART", "HM", , , vbTextCompare)
End Function

Function finaldata_2(data)
  Dim a As Variant, itm As Variant
  Dim valores As New Collection
  Dim bex As Boolean
  Dim i As Long

  For Each itm In Split(data, " ")
    bex = False
    For i = 1 To valores.Count
      Select Case StrComp(valores(i), itm, vbTextCompare)
        Case 0
          bex = True
          Exit For
        Case 1
          bex = True
          valores.Add itm, itm, Before:=i
          Exit For
      End Select
    Next
    If bex = False Then valores.Add itm, itm
  Next
  ReDim a(1 To valores.Count)
  For i = 1 To valores.Count
    a(i) = valores(i)
  Next
  finaldata_2 = Join(a, " ")
End Function

 

[DanteAmor]

Im glad to help you. Thanks for the feedback