VBA find script

**nygwnj** · 12-09-2009, 01:32 PM

I had posted this a while back, since then I got some results with a shortened version. This version is not giving me desired results.

It should find four orders that total to 126.63. I separated the data in to days so run time was reasonable.

It's not finding any combinations of four for that total. I want to verify that the code is correct.

Whole spreadsheet attached.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 11/19/2009 by orders
'

'
    
    
    Dim finish As Integer, start As Integer
    Dim firstval, secondval As Double
    Dim counter As Integer, innerstart1 As Integer, innerctr1 As Integer
    Dim endfin As Integer
    Dim tot_val As Double
    Dim innerctr2 As Integer, innerctr3 As Integer
    Dim innerstart2 As Integer, innerstart3 As Integer
    
    Dim innerctr4 As Integer, innerstart4 As Integer
    Dim third_val As Double, fourth_val As Double
    Dim outerctr As Integer
    Dim name_zip1 As String, name_zip2 As String, name_zip3 As String
    Dim name_zip4 As String, name_zip5 As String
    
    Dim date_k1 As String, date_k2 As String, date_k3 As String
    Dim date_k4 As String, date_k5 As String
    Dim x As Integer
    
    
    Dim thisRow As Integer, prevRow As Integer, myCol As Integer
    thisRow = 0
    prevRow = 0
    
    Selection.SpecialCells(xlCellTypeLastCell).Select
    endfin = ActiveCell.Row - 1
    start = 0
    
    innerstart1 = start + 1
    innerstart2 = start + 2
    innderstart3 = start + 3
    innerstart4 = start + 4
    
    
    Range("P3").Select
    
    
    
    
    
    For counter = start To endfin - 4
        
        firstval = ActiveCell.Value
        thisRow = ActiveCell.Row
        ActiveCell.Offset(0, -6).Range("A1").Activate
        name_zip1 = ActiveCell.Value
        ActiveCell.Offset(0, -6).Range("A1").Activate
        date_k1 = ActiveCell.Value
        ActiveCell.Offset(0, 12).Range("A1").Activate
        
        
        
            
            
            For innerctr2 = innerstart2 To endfin - 2
            
                ActiveCell.Offset(1, 0).Range("A1").Activate
            
                thirdval = ActiveCell.Value
                ActiveCell.Offset(0, -6).Range("A1").Activate
                name_zip3 = ActiveCell.Value
                ActiveCell.Offset(0, -6).Range("A1").Activate
                date_k3 = ActiveCell.Value
                ActiveCell.Offset(0, 12).Range("A1").Activate
                
                
                For innerctr3 = innerstart3 To endfin - 2
            
                    ActiveCell.Offset(1, 0).Range("A1").Activate
                
                    fourthval = ActiveCell.Value
                    
                    ActiveCell.Offset(0, -6).Range("A1").Activate
                    name_zip4 = ActiveCell.Value
                    ActiveCell.Offset(0, -6).Range("A1").Activate
                    date_k4 = ActiveCell.Value
                    ActiveCell.Offset(0, 12).Range("A1").Activate
                    
                    For innerctr4 = innerstart4 To endfin
            
                        ActiveCell.Offset(1, 0).Range("A1").Activate
                
                        fifthval = ActiveCell.Value
            
                        ActiveCell.Offset(0, -6).Range("A1").Activate
                        name_zip5 = ActiveCell.Value
                        ActiveCell.Offset(0, -6).Range("A1").Activate
                        date_k5 = ActiveCell.Value
                        ActiveCell.Offset(0, 12).Range("A1").Activate
            
                        tot_val = Round(secondval + thirdval + fourthval + fifthval, 2)
        
       
                        If tot_val = 126.63 Then
                
                            thisRow = ActiveCell.Row
            
                          
                
                            ' move to memo field, put names msgbox
                            MsgBox " Name2: " & name_zip2 & "Name3: " & name_zip3 & "Name4: " & name_zip4 & " name_zip5 " & name_zip5
                            MsgBox "Date2: " & date_k2 & " Date3: " & date_k3 & " Date4: " & date_k4 & " date_k5 " & date_k5
             
                
                        End If
                    
                    
                    Next innerctr4
                
            innerstart4 = innerstart3 + 2
            Range("P3").Select
            ActiveCell.Offset(innerctr3 + 1, 0).Range("A1").Activate
    
         
            
            Next innerctr3
            innerstart3 = innerctr2 + 2
            
            
            
        Range("P3").Select
        ActiveCell.Offset(innerctr2 + 1, 0).Range("A1").Activate
            
        Next innerctr2
        innerstart2 = innerctr1 + 2
        Range("P3").Select
        ActiveCell.Offset(innerctr1 + 1, 0).Range("A1").Activate
        
        If counter = 19 Then
            x = 1
        End If
                
    Next counter
    
   
        
    
   
        
End Sub

Thanks,

Gary

**davegugg** · 12-09-2009, 04:20 PM

Your code is not working because it is only examining consecutive rows. It will only find the correct combination if the rows are all next to each other. Try this instead:

Public Sub nygwnj()

Dim lngBottomRow As Long

lngBottomRow = Sheets("Sheet1").Cells(Rows.Count, "P").End(xlUp).Row - 1

For a = 3 To lngBottomRow
    For b = 4 To lngBottomRow
        For c = 5 To lngBottomRow
            For d = 6 To lngBottomRow
                If a = b Or a = c Or a = d Or b = c Or b = d Or c = d Then
                'Do Nothing
                Else
                    With Sheets("Sheet1")
                        If .Cells(a, "P").Value + .Cells(b, "P").Value + .Cells(c, "P").Value + Cells(d, "P").Value _
                        = 126.63 Then
                            MsgBox "Use the Sales in rows " & a & ", " & b & ", " & c & ", and " & d & ".", vbOKOnly, "Found"
                            GoTo Found
                        End If
                    End With
                End If
            Next d
        Next c
    Next b
Next a

MsgBox "No combinations added up to exactly 126.63.", vbOKOnly, "Not Found"

Exit Sub

Found:

End Sub

I used your Sheet1 in the example you posted. Let me know if you have any questions.

**TimK** · 12-09-2009, 08:53 PM

I have attached a modified version of your worksheet called Test.xls.

There are 10516 different combos that = 126.63.
See the last sheet and sub in Module3.

Hope this helps.

**nygwnj** · 12-09-2009, 10:51 PM

I don't know why my code only examines adjacent cells, or why you found so many combos. my code advances the inner loop, one cell at a time, with the loop outside it starting one cell right above where the inner loop started. Therefore, it doesn't not only consider adjacent cells. The same applies to all outer loops. this is how I understand it, but I am a novice programmer and defer to you once you explain it.

My code also advances the starting point of all loops by one each time an outer loop starts over.

innerstart3 = innerctr2 + 1.

If an outer loop just advanced, the next inner loop starts just below it, so the same cell isn't considered twice in a combo.

It seems your code would have the same cell considered twice in a combo because an when an outer loop advances, the inner loop still starts where it did which is now where the next outer one is starting. Am I wrong? Now i see why you got so many combos - you ran it on the entire data set. The four orders were most likely to be entered on the same day. This cuts down the execution time and the hits. I will try your code on a day by day basis.

Do you know anything about it eating up RAM and crashing? I was taught that at one point regarding loops. This happened with one day but I don't know how to change it so memory isn't always allocated.

GAry

**davegugg** · 12-10-2009, 11:05 AM

You are correct, your code does loop through all possibilities. I missed that, sorry. A couple of things to point out:
1) You don't need to activate the cells before you check the values. Activating them makes the code run significantly slower. See how I checked the values without activating the cells in my code.
2) When you have something that is going to loop through so many possibilities, to increase the speed it is a good idea to turn screen updating off. Application.ScreenUpdating = False. You can turn it back on at the end of your code.
3) Near the beginning of my code I find the lowest cell in the column. That way I'm not searching any blank rows. With your code you search empty cells, which have a value of 0. Thus if you NEED 4 sales to pool, but 3 add up to the required 126.63, your code will find those 3 and a blank row, which is not a result you wanted.
4) Your code is so spaced out it is very difficult to read. I don't know of a reason to include so many empty row, crunch it together using only 1 empty row to separate sections.
5) Regarding my code searching the same row more than once in one combo, that is why I include If a = b or a = c... then do nothing. It basically skips that combo.

Hope that helps!

**nygwnj** · 12-10-2009, 12:18 PM

Thanks for that reply. i realized soon after sending that your if a = b eliminates dub cell checking.

I pasted your code into another workbook - it is attached. I updated it for finding two orders = 66.04 but it is not running. Can you check it out?

As you say, my code works, so I don't know why my versions weren't yielding anything. Maybe there's some other bug.

I added a "TestSheet" for the results, as per your code, and the data is all in "TEst" sheet. It's all the days in one sheet because it's just a doubly nested loop and doesn't take that long.

I will try your original code for the 122.63 total soon, day by day.

Gary

**nygwnj** · 12-10-2009, 01:15 PM

I ran your code on the larger total (123.6 or whatever) and haven't gotten a hit. I attached it. Can you take a look? It needs to be ran per day, so if you don't have time that is ok. Can you just check the module3 in which I put the code? I will run it on my own.

If you have time to run it per day, that would be great. AS it is setl up - should he results for each execution appear in the testsheet worksheet? Will it overwrite it for the next execution on another day?

Gary

**nygwnj** · 12-10-2009, 04:46 PM

Problem solved! I cruised through a download from verisign and sorted it so only orders that got batched were left. Then i sorted by day and found combos that totaled to 66.04. Sure enough, on July 14, there was on totaling 66.03. I knew batches could be off by a penny. My date range was 6.30 - 7.15 and on the 14th I found two orders totaling to 66.03 by trial and error and we finally found them in the orders box.

As for the total of 126.23, no combos of four for its date range even came close - most days had two or three orders charged that day, only a few even had four.

However, your help still might be valuable because my verisign dump doesn't include orders with .00 ending amounts ($xx.00) because i use a certain script that pulls retail orders, as opposed to memberships. The QuickBooks dumped, on the other hand, has these $0 amounts, so they might be in there. hence, your feedback on Copy of Book 17 is still welcome.

Hope that wasn't TMI, and Happy Holidays,

Gary

**nygwnj** · 12-11-2009, 10:36 PM

DEspite having fun writing these scripts, we found some orders using a different technique. Thanks to all who offered advice. The short script actually did find the winning combination, but I told a volunteer to not search for that one (out of abougt 40) for some dumb reason so the orders didn't get pulled until we found them a different way. Upshot - the script actually did work the way I wrote it.

gary