value points to cell C1 3

[natedeia]

************this is before
Option Explicit
Const THEFT_THRESHHOLD = 0.75
Const SEARCH_COLUMN = "A:A"
*************this is after, does not work
Option Explicit
Const THEFT_THRESHHOLD = Worksheets("Sheet1 (2)").Cells(1, 3).Value
Const SEARCH_COLUMN = "A:A"

Zathras helped me with this one but need to change just a tad. I would like have cell C1 hold the value in place of where the 0.75 is in the above one. Can someone tell me what is wrong with second example.

 

[Golom]

It's probably because a Const is evaluated before any code is executed. "THEFT_THRESHHOLD" requires that some code be run and that's not possible for a constant.

You may want to make "THEFT_THRESHHOLD" a public variable so that you can set its value to "Worksheets("Sheet1 (2)").Cells(1, 3).Value

 

[Zathras]

Or you can simply use "[C1]" in place of "THEFT_THRESHHOLD" in the second subroutine, and remove the const definition altogether.

 

[natedeia]

thanks Golom for that advice, i was going to take it public and work another macro in it but i tried Zathras' suggestion and it works perfectly, with no major changes.
I was hoping to try the same thing with the Search Column. I was going to make cell C2 the cell that will allow users to pick which column that the macro needs to run on. Probably going to put a drop down with like AA:AA,BB:BB,CC:CC, etc since i do not see how to just type in A for that column and it will pick AA:AA. But it looks like to me that it would be possible to apply the [C1] solution to the Search Column, tried it several ways.

 

[natedeia]

Set r = Intersect(Range("C2"), ActiveSheet.UsedRange)
nFirstRow = 1

can't do this?

 

[natedeia]

The below code is what I am trying to change. Tried everything I know about this, which is not much as of yet, but am trying to have cell C2 to be the cell to type in the column that the macro should run on. I have tried several changes and some recommended ones too but not working yet. Can someone help me past this problem? Thanks again Zathras for code.

Option Explicit
Const SEARCH_COLUMN = "A:A"

Sub CheckForPossibleTheft()
Dim r As Range
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nRow As Long
Dim nRowX As Long

Set r = Intersect(Range(SEARCH_COLUMN), ActiveSheet.UsedRange)
nFirstRow = 1
nLastRow = r.Rows.Count
' Clear all bold
For nRow = nFirstRow To nLastRow
r.Cells(nRow, 1).Font.Bold = False
Next nRow
' Bold all near same pairs
For nRow = nFirstRow To nLastRow - 1
For nRowX = nRow + 1 To nLastRow
If NearSame(r.Cells(nRow, 1), r.Cells(nRowX, 1)) Then
r.Cells(nRow, 1).Font.Bold = True
r.Cells(nRowX, 1).Font.Bold = True
End If
Next nRowX
Next nRow
End Sub

 

[Zathras]

One possibility is to require the user to select the column by clicking on the column letter before running the macro. The code to support that consists of changing the first line of the first macro to

  Set r = Intersect(Selection, ActiveSheet.UsedRange)

(and delete the constant declaration for SEARCH_COLUMN)

However, if you prefer to have the user type a letter in C2 (or pick from a drop-down) you can do that too by amending the first macro to look something like this:

:
:
Dim nRowX As Long
Dim sSearchColumn

  sSearchColumn = [c2] + ":" + [c2]
  Set r = Intersect(Range(sSearchColumn), ActiveSheet.UsedRange)
  nFirstRow = 1
:
:

All that's wanted in cell C2 is a single letter.

 

[natedeia]

Thanks Zathras, I implemented the new code which works great. Weird thing is that it is highlighting the >= sign and an error box appears which states Compile Error: Type Mismatch.
I have been trouble shooting, it seems that I have put it on 3 different spreadsheets, but giving above error message on 1 of the spreadsheets. I have several worksheets and it appears to work on one, really strange. Any ideas what would be causing this problem?

 

[natedeia]

oops here is the code!



Private Function NearSame(A As String, b As String) As Boolean
Dim x As Integer
Dim C As Integer
Dim n As Integer
n = Len(A)
If n > 0 Then
For x = 1 To n
If Mid(A, x, 1) = Mid(b, x, 1) Then C = C + 1
Next x
If (C <> n) Then
If (C / n >= [C1]) Then
NearSame = True
End If
End If
End If
End Function
End If
End Function

 

[natedeia]

does it matter that I am using Office 97?

 

[Zathras]

Office 97 is where I developed the first solution, so that is not the problem. I can't imagine why it would work on some sheets and not others. Use this to test:

Option Explicit
Public FRAUD_THRESHHOLD As Double

Sub test()
  FRAUD_THRESHHOLD = ActiveSheet.Range("C1").Value
  MsgBox NearSame("1234", "1236")
End Sub

Private Function NearSame(A As String, b As String) As Boolean
Dim x As Integer
Dim C As Integer
Dim n As Integer
  n = Len(A)
  If n > 0 Then
    For x = 1 To n
      If Mid(A, x, 1) = Mid(b, x, 1) Then C = C + 1
    Next x
    If (C <> n) Then
      If (C / n >= FRAUD_THRESHHOLD) Then
        NearSame = True
      End If
    End If
  End If
End Function

BTW, in a earlier post you gave this:
[tt]
Set r = Intersect(Range("C2"), ActiveSheet.UsedRange)
[/tt]
Do you see what is wrong with that? it is exactly equivalent to
[tt]
Set r = Range("C2")
[/tt]
since the intersection of a single cell and the used range will always be just that single cell.

 

[natedeia]

yea i see that problem now with that code, i am picking up some of this but for the most part it is very impressive. makes my head ache with all this trouble shooting and trying to comprehend the code. anyways, strange thing, i was having that above problem and noticed that if i made more than one module and named them different things like K2, C1, E2, ETC, (i am applying this code to different worksheets in the same workbook but have to place the cell * ie:If (C / n >= [L2]) Then * in different place due to other data being in the way) so i made the different modules and it screws up when i do that, BUT if i just place the code on the worksheet and link the button to that on each and change that cell it works! I must be missing something cause it works with just one module.
It wont let me give you another for star for that but great work i must say!
i tested that Test script out and it just poped up a box saying true no matter what i did, i ran it without the NearSame, was that right?
one last question (yea right), ummm that code
:
:
Dim nRowX As Long
Dim sSearchColumn

sSearchColumn = [c2] + ":" + [c2]
Set r = Intersect(Range(sSearchColumn), ActiveSheet.UsedRange)
nFirstRow = 1
:
:
I place this code and get an error message, it highlights the +, and a couple times gave me an ambigious error.

 

[Zathras]

The little test sub will always pop up a message box, but it will indicate either True or False according to the value in C1 of the active sheet. E.g., if C1 is 0.9 then the message will read "False"

Not sure what an "ambiguous error" is, but the use of the short-hand expression [C2] can give you unexpected results when you have multiple sheets in the workbook. It will give you the value from cell C2 in whichever worksheet is currently active.

You can use the same macro with multiple worksheets, you just have to be careful keep track of what you are doing. If you can give me a little more information about the structure of your workbook and what it is you want to have happen, perhaps I can give you a little better help. So far, all I have seen is that you have a worksheet with one or two columns of numbers that you want to check for "near hits"

Since I now know that you have thousands of rows to search through, here is a "souped up" version of the original code that crunches 4000 9-digit numbers in just under 12 minutes on my slow (500 KHz) machine:

Option Explicit
Const THEFT_THRESHHOLD = 0.75
Const SEARCH_COLUMN = "A:A"

Sub CheckForPossibleTheft()
Dim r As Range
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nRow As Long
Dim nRowX As Long
Dim sAtRow As String
Dim sAtRowX As String
Dim b As Boolean
Dim a As Variant

  Set r = Intersect(Range(SEARCH_COLUMN), ActiveSheet.UsedRange)
  a = r.Rows
  nFirstRow = 1
  nLastRow = r.Rows.Count
  ' Clear all bold
  For nRow = nFirstRow To nLastRow
    r.Cells(nRow, 1).Font.Bold = False
  Next nRow
  ' Bold all near same pairs
  With r
    For nRow = nFirstRow To nLastRow - 1
      Application.StatusBar = "Checking row " & nRow & " of " & nLastRow
      DoEvents
      sAtRow = a(nRow, 1)
      For nRowX = nRow + 1 To nLastRow
        sAtRowX = a(nRowX, 1)
        If NearSame(sAtRow, sAtRowX) Then
          .Cells(nRow, 1).Font.Bold = True
          .Cells(nRowX, 1).Font.Bold = True
        End If
      Next nRowX
    Next nRow
  End With
  Application.StatusBar = False
End Sub

Private Function NearSame(a As String, b As String) As Boolean
Dim x As Integer
Dim c As Integer
Dim n As Integer
  n = Len(a)
  If n > 0 Then
    For x = 1 To n
      If Mid(a, x, 1) = Mid(b, x, 1) Then c = c + 1
    Next x
    If (c <> n) Then
      If (c / n >= THEFT_THRESHHOLD) Then
        NearSame = True
      End If
    End If
  End If
End Function

The slowest part of the code was retrieving data from each spreadsheet cell, so by getting them all at once in a large Variant (which can then be processed as an array) it shaves off quite a bit of time. It is possible to cut off another 2 minutes (for a run time of approx 10 minutes on my machine) by adding a little more code to transfer the data from the variant to a string array and then processing the string array instead of the variant array.

You can modify this version to use values from the spreadsheet as indicated in previous posts.

 

[natedeia]

Did I insert the code correctly, it seems ok but keep getting a Type Mismatch error pop up. I would really like to use the feature of this function for selecting the column by using C2. It seems, for me, to go through the column and unBOLD the characters but then gives that error.
I was running you newest version of this macro and it runs impressively fast! It does however slow down when I set C1 for the theft_threshold. I even just selected the cells and not the whole column, still slower but faster than before. Still man, I appreciate every second of your time that was spent pondering on the idea of this and how you have evolved it. Some of the investigators are interested in this and I did not take the credit for it, told them a friend did it. Can't stop all of those career crooks but things like this and many other tools make it a little harder!

Option Explicit

Sub CheckForPossibleTheft()
Dim r As Range
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nRow As Long
Dim nRowX As Long
Dim sAtRow As String
Dim sAtRowX As String
Dim b As Boolean
Dim a As Variant
Dim sSearchColumn

sSearchColumn = [c2] + ":" + [c2]
Set r = Intersect(Range(sSearchColumn), ActiveSheet.UsedRange)
nFirstRow = 1
nLastRow = r.Rows.Count
' Clear all bold
For nRow = nFirstRow To nLastRow
r.Cells(nRow, 1).Font.Bold = False
Next nRow
' Bold all near same pairs
With r
For nRow = nFirstRow To nLastRow - 1
Application.StatusBar = "Checking row " & nRow & " of " & nLastRow
DoEvents
sAtRow = a(nRow, 1)
For nRowX = nRow + 1 To nLastRow
sAtRowX = a(nRowX, 1)
If NearSame(sAtRow, sAtRowX) Then
.Cells(nRow, 1).Font.Bold = True
.Cells(nRowX, 1).Font.Bold = True
End If
Next nRowX
Next nRow
End With
Application.StatusBar = False
End Sub

 

[Zathras]

Well, you left out the line
[tt]
a = r.Rows
[/tt]
Also, the slowness comes from referencing [C1] every time. You should declare a variable and then populate it from [C1] once. Then use the variable for the test inside the function.
[tt]
Dim nTestThreshhold as double
nTestThreshhold = [C1]
[/tt]
What line exactly is highlighted when you get the Type Mismatch error? And what exactly do you have in cells C1 and C2?

 

[natedeia]

eww I see that, staring at these screens too much, can't believe I missed that. just ran it and it runs much better. running it on 10,600 rows now, in 9 minutes it went 1000 rows. It does start speeding up once it gets closer to halfway. Some of the guys here pull data which have like 30,000 rows, had to tell them to run it right when they leave work so it will be waiting for them in the morning. If I run this macro on two different worksheets in the same workbook will that make it run extra slow? Just wondering cause there are normally at least two columns that would need it, normally. May try a few tests after this runs.
Someone asked me if the digits that did not match could be colored? I could not find anything like that online and working through my VB6 book would take a while for that answer. Possible?

 

[xlbo]

If you have a 30k record comparison match to do I would suggest porting over to Access - it will be much more efficient. 'Course - you'd have to write a whole new batch of code......:-(

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question

 

[PHV]

For performance issue you may take a look here:

http://www.tek-tips.com/faqs.cfm?fid=4105

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[Zathras]

Coloring the digits is possible. Wouldn't slow it down too much since it would only be operating on the ones that are now being bolded.

As I indicated, it could be made a little faster with a bit more code. However, it may be time to step back and consider the over-all design of what you are trying to do.

It would seem that you need to do one massive (overnight) run with all of the data you have so far, then all you need to do is to process additions as they arrive. For example, say you have 30,000 in your database. Process those in one pass. Now say you have 1,000 additions. You don't need to process 31,000 against 31,000, all you really need to process is 1,000 against 31,000. Do you see that? (Add the 1,000 to the database, then check each of the new 1,000 against the database.)

This would work well with a database such as Access as Geoff has suggested. But it can still fit into Excel if you wish (up to 65,000 or so - and beyond if you are comfortable with 2-dimension arrays).

What that means is to re-design your approach and designate two columns in the spreadsheet: One for the "31,000" and one for the newly added "1,000." Then the code would be revised to process 1,000 in the outer loop and reference the 31,000 in the inner loop.

Net result: After the initial (slow) check, subsequent additions can be handled relatively quickly.

Best bet: Make this part of the addition process so that for each number added it is checked against the database before adding it. In other words, the outer "loop" would consist of one pass for the number being added. Also, from a systems design standpoint, it would probably be better to extract the numbers of interest into a third column (actually third and fourth columns by listing the pairs) instead of bolding them. Scanning a list of 30,000 numbers for which ones are bolded is not easy.

The FAQ pointed to by PHV contains very useful tips for future reference, but does not have much application in your particular case. (We're not doing much screen updating; we're doing no copying; and the code is already using "With".) Nevertheless, you should take a look at it when you have time.

 

[natedeia]

I agree scanning a list of 30,000 numbers is not an easy task. Forgot to email myself the code from home but I am adding a function to take all the rows in which there is a cell that is in BOLD and dump it on the next or another worksheet.
I wish I could go into detail more on the subject where this macro is being used (what the data is exactly) but I probably would get fired for it. I can say that in an day there are hundreds of thousands of transactions which translates into millions of $'s. There are different people taking care of different markets and such but still, if I ran a query for even a third of the US I would be looking at too much. Zathras' idea would be good for a couple of the queries but there are always too much going on every minute that 1000 against 30000....well I can use that idea if running something, sort it by the time if just looking at today info, then take those new ones after 'X' time and then do what you said. But still, everyone has been a great help and thanks for the link PHV, I like saving time!
Xlbo, yea I use a couple different software packages to query a couple different DB's, Access is actually one of them, it is already set up nicely with all the correct data types, but I couldn't even come close to what Zathras did....and the Oracle DB admin is almost impossible to get a hold of. I am almost forbidden to bother him......you know why? Because all these programmers (like you guys) make too much! See we are on differnt levels! ha!
Oh by the way, it took approx half an hour to do 10,600 rows on a 2.6 mhz Celeron IBM machine, guess it totally does not matter on the processor.