Excel 97 Macro Help for Science

[ChiefWiggum]

I need a solution to actually a simple problem really quickly. My problem is that I have not programmed in a long time, so I know the general algorithm of what needs to be done-- but the code.

Here goes:

Review: I primarily deal with a 15 code: 14 octal values plus 1 binary
value at the end: ie. 77777777777771 (cell1)or 657413777010111 (cell2) The values are actually codes for DNA fingerprints of Tuberculosis isolates

Now those two particular codes are dissimilar, but say if I changed
the second code to: 767777757777770, this one would be more closely related to
the first one. there are only three differences in the code. A 6/7, 5/7
and a 1/0. I think anything beyond three integer differences would be
significant.

What I'd like to do would be, is to highlight cell1 (then use a trigger
event, like CRTL-whatever) and have it spit out (sort or filter) all the
values in that column that come under that max difference integer
threshold. Frankly my way, would just be sorting and physically looking
for similar patterns.

But that would be pretty time consuming.

So, say we have these two columns:
colA colB
515563435640731 X1

777777777720771 X2 <- If I hightlight this: (777777777720771, col A)

777777777760731 X3

776377777760771 X4

777777777760771 X5

I'll get this:
colA colB
777777777760731 X3 (2 integer difference)

776377777760771 X4 (3 integer difference)

777777777760771 X5 (1 integer difference)

The algorithm would be as follows:
Highlight cell (value) in colA
Trigger event/start macro
Search col A for values <=3 integer(character) differences
Display applicable col A values and colB data.
End

I know it's a lot, but it'd be great help. And help me learn as well!
Anyone got any ideas?

Thanks!

 

[ChiefWiggum]

bump.

anyone?

 

[Hector13]

this isn't the most elegant solution, but it should work:

Sub FindNearMatches()
Dim criteriaCell As Range
Dim strCriteria As String
Dim strSearch As String
Dim intDiffCount As Integer ' number of differences in current value
Dim searchCell As Range

Set criteriaCell = ActiveCell
strCriteria = Trim(criteriaCell.Value)

For Each searchCell In criteriaCell.EntireColumn.Cells
strSearch = Trim(searchCell.Value)
If Len(strSearch) > 0 Then
intDiffCount = 0
For i = 1 To Len(strSearch)
If Mid(strSearch, i, 1) <> Mid(strCriteria, i, 1) Then
intDiffCount = intDiffCount + 1
End If
Next i
If intDiffCount <= 3 Then
searchCell.Interior.ColorIndex = 4
Else
searchCell.Interior.ColorIndex = 0
End If
searchCell.Offset(0, 2) = intDiffCount
End If
Next searchCell

End Sub


Just drop this into a module and assign it to a macro key if you want.

The code basically goes through each cell in the current columnt and loops through each character of that cell's value and compares it to the same character of the &quot;criteria&quot; cell. If you can, you should change the code to accept a search range since right now it looks through the whole column (about 65000 rows) which is a waste of time if only a few hundred have codes in them.

Right now, it will also put the count of difference in a cell 2 columns to the right of the cells it is searching, but you can get rid of that easily.

Good luck

 

[Hector13]

I didn't realize the forum software would get rid of all the tabs and other whitespace, so that code looks like crap, but it should still work. Let me know if you have any problems.

 

[ChiefWiggum]

Thanks Hector13!

I will try it out. I'll let ya know if it works.

Mike

 

[ChiefWiggum]

Works!

 

[Helpless]

nice You want to help a rookie MS Access user, too?

 

[Hector13]

well, I haven't used access in a while, but if it is a VBA type question than I might be able to help you a bit.

 

[Helpless]

My Question Thread


As for a VBA question, I do have one...in excel, I tried to create a macro that would auto-correct a whole list of letter acronyms, the FFR (for fat-free), L/F, etc, etc..and have it auto-replace the acronym with the corresponding word?any ideas? I posted that question HERE.