[ExcelVBA] Re: Binary Search Problem

 

Paul,
Thank you. I've never used dictionary objects before, so this is a learning experience for me. :-) Your code works well and I've applied it to my project. I have to ask though, you converted everything to upper case when you loaded the dictionary, and when you search the dictionary, you convert the search string to uppercase as well. Will the search still work correctly if you don't convert everything to upper case? In many of my applications of this data, I'm looking for differences like case and extra spaces, etc.

Scott

--- In ExcelVBA@yahoogroups.com, Paul Schreiner <schreiner_paul@...> wrote:
>
> I think I've found a couple of problems.
>
> #1 may be a "case" issue.
> I've found  a couple of cases where lowercase is used in one list, but uppercase
> is used in another:
> (p01-070161-01411-A100)
>
> #2.. You're using an Interval Halving technique for searching the list.
> However, for it to work properly, the data has to be sorted correctly.
>
> Unfortunately, it doesn't look like it's sorting properly.
> Specifically,
> the ASCII code for "-" is 45
> the ASCII code for "0" is 48
> (1-9 are codes 49-57)
>
> But in the sort, "-" is sorted AFTER numbers.
> (see rows:
> 6115: 020-SUB-0011
> 6116: 02-16917-3600
>
> 12513: 400-TUNECVR-0003
> 12514: 40-26314
> )
>
> for that reason, when the interval happens to test lines comparing 020 to 02-,
> it assumes that the 020 should be AFTER 02-, but the next iteration finds that
> it is outside the range,
> and therefore assumes it cannot find it.
> I'm not sure what can be done about this sorting problem, however, I have an
> alternate solution.
>
> I prefer to use a Dictionary object instead of arrays.
>
> try this macro:
>
> Sub CompareUsingDict()
>     Dim x As Long
>     Dim sdlast As Long
>     Dim pilast As Long
>     Dim y As Object
>     Dim Dict_SD, Dict_PH
>     Dim tstart, tstop, TElapsed, TMin, TSec, msg
>     tstart = Timer
>     '-----------------------------------------------------
>     Set Dict_SD = CreateObject("Scripting.Dictionary")
>         Dict_SD.RemoveAll
>     Set Dict_PH = CreateObject("Scripting.Dictionary")
>         Dict_PH.RemoveAll
>     '-----------------------------------------------------
>    
>     Application.EnableEvents = False
>     Application.ScreenUpdating = False
>     Application.Calculation = xlCalculationManual
>     Sheet1.Activate
>    
>     'Get the size of the other two databases
>     sdlast = Sheet2.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows,
> SearchDirection:=xlPrevious).Row
>     pilast = Sheet3.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows,
> SearchDirection:=xlPrevious).Row
>     For x = 3 To sdlast
>         If (Not Dict_SD.exists(UCase(Sheet2.Cells(x, 1).Value))) Then
>                 Dict_SD.Add UCase(Sheet2.Cells(x, 1).Value), x
>         End If
>     Next x
>     For x = 3 To pilast
>         If (Not Dict_PH.exists(UCase(Sheet3.Cells(x, 1).Value))) Then
>                 Dict_PH.Add UCase(Sheet3.Cells(x, 1).Value), x
>         End If
>     Next x
>     x = 3
>     Do While Not Cells(x, 1) = ""
>         If (Dict_SD.exists(UCase(Sheet1.Cells(x, 1).Value))) Then
> Sheet1.Cells(x, 4).Value = Dict_SD.Item(UCase(Sheet1.Cells(x, 1).Value)) '"Y"
>         If (Dict_PH.exists(ucase(Sheet1.Cells(x, 1).Value))) Then
> Sheet1.Cells(x, 5).Value = Dict_PH.Item(ucase(Sheet1.Cells(x, 1).Value)) '"Y"
>         x = x + 1
>     Loop
>     Application.EnableEvents = True
>     Application.ScreenUpdating = True
>     Application.Calculation = xlCalculationAutomatic
>        
> 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
>
>             msg = "Using Dictionary"
>             tstop = Timer
>             TMin = 0
>             TElapsed = tstop - tstart
>             TMin = TElapsed \ 60
>             TSec = TElapsed Mod 60
>             msg = msg & Chr(13) & Chr(13)
>             If (TMin > 0) Then msg = msg & TMin & " mins "
>             msg = msg & TSec & " sec"
>             MsgBox msg
>        
> 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
>
> End Sub
>  
>
> hope this helps.
> Paul
> -----------------------------------------
> “Do all the good you can,
> By all the means you can,
> In all the ways you can,
> In all the places you can,
> At all the times you can,
> To all the people you can,
> As long as ever you can.” - John Wesley
> -----------------------------------------
>
>
>
>
> ________________________________
> From: Scott <scott@...>
> To: ExcelVBA@yahoogroups.com
> Sent: Thu, October 6, 2011 4:08:52 PM
> Subject: [ExcelVBA] Binary Search Problem
>
>  
> I'm having a problem with a binary search of three databases. I'm trying to
> compare 86,000+ strings in one database against two other databases, each with
> over 86,000 entries as well. When I load the other two into arrays, then perform
> a binary search of the two arrays, I get 274 "hits" as being missing as compared
> to the master. But if I search the the same two databases using a FIND function
> (which takes an hour to run) I only get 85 hits. The two arrays are sorted,
> which I've double checked with a simple =if(a2<a3.... formula. I just can't
> figure it out. My binary search is below
> ------------------- CODE ----------------------
> Function BinarySearch(strArray() As String, strSearch As String) As Long
> Dim lngIndex As Long
> Dim lngFirst As Long
> Dim lngLast As Long
> Dim lngMiddle As Long
> Dim bolInverseOrder As Boolean
> lngFirst = LBound(strArray)
> lngLast = UBound(strArray)
> bolInverseOrder = (strArray(lngFirst) > strArray(lngLast))
> BinarySearch = lngFirst - 1
> Do
> lngMiddle = (lngFirst + lngLast) \ 2
> If strArray(lngMiddle) = strSearch Then
> BinarySearch = lngMiddle
> Exit Do
> ElseIf ((strArray(lngMiddle) < strSearch) Xor bolInverseOrder) Then
> lngFirst = lngMiddle + 1
> Else
> lngLast = lngMiddle - 1
> End If
> Loop Until lngFirst > lngLast
> End Function
> ------------------- CODE ----------------------
>
> I'll email the file to the moderator so they can post it in the files section.
> Thanks for your help.
>
> Scott B)
>
> moderator edit:
> The file, called BinarySearchProblem.xlsm has been added to the
> Files\Files needing help
> section.
>
>
>
>
> [Non-text portions of this message have been removed]
>

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (4)

Recent Activity:

• New Members 2
• New Files 1

Visit Your Group

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

MARKETPLACE

Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___