VBA Search Help

[Ryski]

Ok. So I might be going about this the wrong way, but here's what I have working so far.


a) I have found and tweaked a macro to search a particular column for particular medical diagnosis codes and then highlight the whole row if the value is in the array. This works great and does what I want it to do.


b) I have set up a macro that will import a SharePoint list to a new tab. This list will contain all of the medical codes that I need the macro to search for. I am going this route so our users will be able to update the search file easily and will be called up by all the people using the search macro.


Where I am failing is to fit the pieces together is to get the search macro to call the data in the other sheet. In this case I am importing the data to a sheet called "Search_Array" and the diagnosis codes are in column "B" but the data I want to search is in the active sheet titled "All Claims by Date of Service". Below is the functioning code, but I can't figure out how to get the search array to be in the other worksheet.

Thanks in advance,

-Ryan

[pre]

Sub PRIMARY_DX_1_search()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim Rng As range
Dim I As Long

MySearch = Array("4293","42500","42800","V570","42600","41400") <--- this where I'd              like to put the array reference to the other worksheet.

With Sheets("All Claims by Date of Service").range("G5:G55000")
For I = LBound(MySearch) To UBound(MySearch)
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
With ActiveSheet.range("B" & Rng.Row & ":O" & Rng.Row)
.Font.ColorIndex = 1
.Interior.ColorIndex = 4
End With
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
End Sub

[/pre]

 

[Luke M]

I think this should do it:

[pre]

Sub PRIMARY_DX_1_search()
Dim FirstAddress As String
Dim MySearch As Range
Dim myColor As Variant
Dim Rng As Range
Dim I As Long

'Name of worksheet with list of codes
With Worksheets("Search_Array")
'Looks at everything in col B, from row 1 to last used row in col B
Set MySearch = .Range("B1", .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, "B"))
End With
Application.ScreenUpdating = False

With Sheets("All Claims by Date of Service").Range("G5:G55000")
For I = 1 To MySearch.Count
Set Rng = .Find(What:=MySearch.Cells(I).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
With ActiveSheet.Range("B" & Rng.Row & ":O" & Rng.Row)
.Font.ColorIndex = 1
.Interior.ColorIndex = 4
End With
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

[/pre]

 

[Ryski]

Luke-


Thanks for the quick reply. That makes sense...but something is causing it to stall out. I've never had to search with a range this large, so it could be that it's just too much data. The previous step will be to import a SharePoint list that ends up formatted as a table. There are 834 rows in the table, however column B only has 14 items.

I converted the table to a range and ran the macro again, but it locks up and I have to force quit.


Maybe I should have also just asked what is the best way to set up a search array with hundreds of search terms? In this particular case, we have to review the diagnosis codes and procedure codes. There are only 14 applicable diagnosis codes, but 833 procedure codes. On the last force quit the debug window popped up for a minute and said something about the "Set Rng = .FindNext(Rng)" line.


What am I missing?

 

[Luke M]

There are 834 rows in the table, however column B only has 14 items.

So, are there blank cells in column B? Like

[pre]

Col A   Col B
123       this
234
345       that
456       some
876
987       this

[/pre]
If so, are the values in col B numbers or text?

 

[Ryski]

There are no blanks. It is because there are fewer diagnosis codes than procedure codes. Eventually it will be column A (ID will be ignored), Column B (DX codes), Column C (procedure codes), Column D (Drug names)

[pre]

Col A     Col B     Col C     Col D
1         4120      89123     Asprin
2         4121      89223     Benadryl
3         4125      90121     Tylenol
4         4230      A0952
5                   A0953
6                   00234

[/pre]
It just happens that the data I have is longer in one column that the others. Eventually I will have to duplicate the same VBA to other columns/data as the search terms.


Hopefully that made sense. There will never be any blanks in the middle of the data.

 

[Luke M]

I just tested the macro on a small sample of data, and it functions correctly. One quick note, we might want to change this

With ActiveSheet.Range("B" & Rng.Row & ":O" & Rng.Row)

to this

With Worksheets("All Claims by Date of Service").Range("B" & Rng.Row & ":O" & Rng.Row)

just to guarantee that the code works properly even if the All Claims sheet is not the active sheet.


Did the code really error out, or had you just done a Ctrl+Alt+Break to pause the code? The latter indicates that the code is just taking awhile to run and we may need to look at trying to speed up the code.

 

[Ryski]

It was still taking forever...so I looked at it again and tried something that fixed the speed issue. The data being imported from SharePoint was another macro step that I was going to call with this one. So I tried converting the table to range and then running the query and for some reason (which will be known to those smarter than I) that fixed the speed.


The code is perfect and I added a change to range step in my import VBA. Like a boss!


Thanks Luke!!

 

[Luke M]

Way to go! Glad we were able to figure it out together.