[RESOLVED] Exe file crashes

My application runs fine from the design window in VB 6.0, when I click the command button. But when I do the same in my exe file, it crashes.

I have added a couple of components to the project. Could this be the reason?

What is the error?

Does it do the same crash on another PC?

How about providing some code that you've used at startup?

I find it generally hard to tell you the problem directly because the problem could be related to so many things. It's hard to tell.

Give the above a shot, and see what me and other members got to say ;)

kregg :)

The code is as follows:

VB Code:

Private Sub Command2_Click()
 
    Dim Txt() As MyData 'stores our data
    Dim i As Long 'counter
    Dim dComb As String 'combination string
    Dim dOutput As String 'output string
    Dim UB As Long 'Ubound of the txt() array
    
    Dim Text1Count As Long, Text2Count As Long, Text3Count As Long, TotalTextCount As Long
    
    i = 0
    dComb = ""
    dOutput = ""
    UB = 0
       
    
    
    
    If Check1.Value = vbChecked And Len(Trim(Text1.Text)) <= 0 Then
    MsgBox "Error: no data in column1"
        Exit Sub
    Else
    If Check1.Value = vbChecked Then
        Text1Count = GetLineCount(Text1)
        Else
        Text1Count = 1
    End If
    End If
 
    If Check2.Value = vbChecked And Len(Trim(Text2.Text)) <= 0 Then
    MsgBox "Error: no data in column2"
        Exit Sub
    Else
    If Check2.Value = vbChecked Then
        Text2Count = GetLineCount(Text2)
        Else
        Text2Count = 1
    End If
    End If
 
    If Check2.Value = vbChecked And Len(Trim(Text3.Text)) <= 0 Then
    MsgBox "Error: no data in column3"
        Exit Sub
    Else
    If Check3.Value = vbChecked Then
        Text3Count = GetLineCount(Text3)
        Else
        Text3Count = 1
    End If
    End If
    
    TotalTextCount = Text1Count * Text2Count * Text3Count
    
    
    UB = -1 'set to invalid
    
    'assign each textbox data to the dynamic array if checked
    If Check1.Value Then
        UB = UB + 1
        ReDim Txt(UB)
        With Txt(UB)
            .tStr = Split(Text1.Text, vbCrLf)
            .Bounds = UBound(.tStr)
        End With
    End If
    If Check2.Value Then
        UB = UB + 1
        ReDim Preserve Txt(UB)
        With Txt(UB)
            .tStr = Split(Text2.Text, vbCrLf)
            .Bounds = UBound(.tStr)
        End With
    End If
    If Check3.Value Then
        UB = UB + 1
        ReDim Preserve Txt(UB)
        With Txt(UB)
            .tStr = Split(Text3.Text, vbCrLf)
            .Bounds = UBound(.tStr)
        End With
    End If
    
    If UB = -1 Then 'none selected so exit
        Exit Sub
    End If
    
    ProgressBar1.Value = 0
    ProgressBar1.Max = TotalTextCount 'Your Value
    ProgressBar1.Min = 0
    
    
    
    Do
    ProgressBar1.Value = ProgressBar1.Value + 1
        For i = 0 To UB
            With Txt(i)
                If Len(.tStr(.index)) Then
                    dComb = dComb & .tStr(.index) & " "
                    Else
                        dComb = vbNullString
                        Exit For
                End If
            End With
        Next i
        
        For i = UB To 0 Step -1
            With Txt(i)
                .index = .index + 1
                If .index > .Bounds Then
                    .index = 0
                Else
                    Exit For
                End If
            End With
        Next i
        If i = -1 Then 'we are done
            Exit Do
        End If
        If Len(dComb) > 0 Then
            dOutput = dOutput & Trim$(dComb) & vbCrLf
            dComb = vbNullString
        End If
        
    Loop
    'MsgBox Len(dOutput)
    Text4.Text = dOutput
    'txtCount = GetLineCount(Text4)
    txtCount = Text4.GetLineFromChar(Len(Text4.Text)) + 1
End Sub

It is run on a command button. Text1,Text2 and Text3 have 3 lines of text in each.

Text4 is the richtextbox.

Extra components added are the progressbar and richtextbox.

The progress bar reaches the end and some data appears in the richtextbox. No count appears. But the hour glass appears and its at 100% CPU.

It all works fine before the exe is made.

How about zipping up and including the whole project since the definition of things like MyData are not shown?

I get a error at the first line:

VB Code:

Dim Txt() As MyData 'stores our data

What is MyData? Does anyone else know what MyData is?

Edit: Follow Marty's idea.

MyDate is below:

VB Code:

Private Type MyData
    tStr() As String
    Bounds As Long
    index As Long
End Type

My boss doesn't want the whole project to go out because it contains some proprietary secrets for his business. :S

GetLineCount is not defined and trying to help you this way is very tedious. At least set up your own project with the code you've posted and try to run it so you can see what else (if anything) is needed.

Also since this is a professional project you should use meaningful control names instead of things like Command2 and Text1.

Quote:

---

Originally Posted by Jon12345

But when I do the same in my exe file, it crashes.

---

Does it throw an error of some kind?

Try replacing your sub with this and see if it give you an idea where things are going wrong.

VB Code:

Private Sub Command2_Click()
 
          Dim Txt() As MyData 'stores our data
          Dim i As Long 'counter
          Dim dComb As String 'combination string
          Dim dOutput As String 'output string
          Dim UB As Long 'Ubound of the txt() array
    
          Dim Text1Count As Long, Text2Count As Long, Text3Count As Long, TotalTextCount As Long
    
   On Error GoTo Command2_Click_Error
 
10        i = 0
20        dComb = ""
30        dOutput = ""
40        UB = 0
       
    
    
    
50        If Check1.Value = vbChecked And Len(Trim(Text1.Text)) <= 0 Then
60        MsgBox "Error: no data in column1"
70            Exit Sub
80        Else
90        If Check1.Value = vbChecked Then
100           Text1Count = GetLineCount(Text1)
110           Else
120           Text1Count = 1
130       End If
140       End If
 
150       If Check2.Value = vbChecked And Len(Trim(Text2.Text)) <= 0 Then
160       MsgBox "Error: no data in column2"
170           Exit Sub
180       Else
190       If Check2.Value = vbChecked Then
200           Text2Count = GetLineCount(Text2)
210           Else
220           Text2Count = 1
230       End If
240       End If
 
250       If Check2.Value = vbChecked And Len(Trim(Text3.Text)) <= 0 Then
260       MsgBox "Error: no data in column3"
270           Exit Sub
280       Else
290       If Check3.Value = vbChecked Then
300           Text3Count = GetLineCount(Text3)
310           Else
320           Text3Count = 1
330       End If
340       End If
    
350       TotalTextCount = Text1Count * Text2Count * Text3Count
    
    
360       UB = -1 'set to invalid
    
          'assign each textbox data to the dynamic array if checked
370       If Check1.Value Then
380           UB = UB + 1
390           ReDim Txt(UB)
400           With Txt(UB)
410               .tStr = Split(Text1.Text, vbCrLf)
420               .Bounds = UBound(.tStr)
430           End With
440       End If
450       If Check2.Value Then
460           UB = UB + 1
470           ReDim Preserve Txt(UB)
480           With Txt(UB)
490               .tStr = Split(Text2.Text, vbCrLf)
500               .Bounds = UBound(.tStr)
510           End With
520       End If
530       If Check3.Value Then
540           UB = UB + 1
550           ReDim Preserve Txt(UB)
560           With Txt(UB)
570               .tStr = Split(Text3.Text, vbCrLf)
580               .Bounds = UBound(.tStr)
590           End With
600       End If
    
610       If UB = -1 Then 'none selected so exit
620           Exit Sub
630       End If
    
640       ProgressBar1.Value = 0
650       ProgressBar1.Max = TotalTextCount 'Your Value
660       ProgressBar1.Min = 0
    
    
    
670       Do
680       ProgressBar1.Value = ProgressBar1.Value + 1
690           For i = 0 To UB
700               With Txt(i)
710                   If Len(.tStr(.Index)) Then
720                       dComb = dComb & .tStr(.Index) & " "
730                       Else
740                           dComb = vbNullString
750                           Exit For
760                   End If
770               End With
780           Next i
        
790           For i = UB To 0 Step -1
800               With Txt(i)
810                   .Index = .Index + 1
820                   If .Index > .Bounds Then
830                       .Index = 0
840                   Else
850                       Exit For
860                   End If
870               End With
880           Next i
890           If i = -1 Then 'we are done
900               Exit Do
910           End If
920           If Len(dComb) > 0 Then
930               dOutput = dOutput & Trim$(dComb) & vbCrLf
940               dComb = vbNullString
950           End If
        
960       Loop
          'MsgBox Len(dOutput)
970       Text4.Text = dOutput
          'txtCount = GetLineCount(Text4)
980       txtCount = Text4.GetLineFromChar(Len(Text4.Text)) + 1
 
   On Error GoTo 0
   Exit Sub
 
Command2_Click_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command2_Click of Form Form1" & vbCrLf & "Error on line number " & Erl
End Sub

What's the secretcy in BROKEN? Are you guarding against someone wanting to fix it?

You haven't answered half the questions asked...

I have installed that error code and there is no error message. Just the 100% CPU. The same thing happens on another PC.

By putting a msgbox after each line of code near the end of my subroutine, I can confirm that it completes all code within the End Sub. Then it crashes. i.e. I have a msgbox "End of routine" just before End Sub. That shows fine. Then I click Ok and it crashes.

Very odd indeed.

Intuition tells me that it might have something to do with the RichTextBox and ProgressBar controls, since I added those later. And I think it worked before these were added, as far as I can recall. The richtextbox used to be just a textbox control.

Quote:

---

Originally Posted by Jon12345

That shows fine. Then I click Ok and it crashes.

---

Ok, well telling us it "crashes" doesn't give us much information.

Do you get an error message when it crashes? Or does it pop up a message saying "... has encountered an error and needs to close", ie: the Send Error Report message on Windows XP.

Also, it's kind of hard to help you fix something when you can't give us the code.

It's like taking a car to a mechanic and saying "Hey can you help me fix my car? I can't let you look under the hood though, because it's a secret."

:ehh:

With 100% cpu usage, I would be looking at a looping problem. Since you got to the end of the button click event I would have to say the problem is elsewhere.

What I mean by a crash is that the CPU goes to 100% and if I hold the mouse over the application, it goes to an hour glass. There is no pop up message of any kind.

Quote:

---

Originally Posted by Jon12345

What I mean by a crash is that the CPU goes to 100% and if I hold the mouse over the application, it goes to an hour glass. There is no pop up message of any kind.

---

Ok, well that's not really a "crash". Most likely a loop that is still going like Mark said.

And with the little code you shared, plus the fact that the variable names/control names aren't really meaningful, makes it harder to figure out what the problem is.

Did you say you didn't have any problems until you added other components to your project?

Check the loop to see if it is dependant on a value changing (should be!), and then see if that value changes when you go through the code. For example:

VB Code:

'Problematic Loop code
Private Sub loopcode()
    x = 0
    Do Until x = 5
         y = y + 1
    Loop
End Sub
 
'Can be corrected by
Private Sub loopcode2()
    x = 0
    Do Until x = 5
         y = y + 1
         x = x + 1
    Loop
End Sub

Hope it helps!

DigiRev, yes you would think it was a loop, but like I said earlier I put a message box just before the End Sub and it got to that just fine. Then, I clicked Ok and the 100% CPU kicked in.

Regarding the components, I cannot remember exactly. I think perhaps I should remove the progress bar and see what happens. If that doesn't work, remove the richtextbox control too.

With the sub that has the messagebox... has that been called anywhere by any chance?

When something like that happens it is usually because you failed to close and destroy objects that you used and when you attempt to close the app VB goes nuts!!!!

You will never reach Exit Do

VB Code:

For i = UB To 0 Step -1
            With Txt(i)
                .index = .index + 1
                If .index > .Bounds Then
                    .index = 0
                Else
                    Exit For
                End If
            End With
        Next i
        If i = -1 Then 'we are done
            Exit Do
        End If

This is because your always resetting .index to zero... or you will always have at least one Txt(i) array element with .index <= .Bounds, which in turn calls Exit For, which in turn keeps i from getting to -1


Tell us what you are trying to accomplish with that procedure... make the explanation descriptive... so we can rewrite the procedure (or relevant part) for you.

Its strange though that a msgbox statement at the end of the procedure is executed... that should only happen when UB = 0, and larger values for UB would produce the infinite loop.... is that the case? on what test value does the procedure work and on what test values does it loop infinitely.

EDIT: My bad... it actually reaches the Exit Do eventually... but the increase in the number of loops when .Bound or UB is increased is very very large. Consider UB=2 and all .Bound = 2... loops (Fors + Do) would be around 3*3*3... if UB and all .Bound were increased to 5 then you would have around 5*5*5.

Also consider disabling the button when its clicked and just reenable it before End Sub so the click event is not placed in the call stack... otherwise you could be running the long procedure several times if the user kept clicking the button during "hang".

If the source for the combinations are from textfiles then you can create a cartesian join of the textfiles through SQL+ADO...

By any chance are you running your exe on another machine or in another folder other than the development folder?

I am going to take a risk and upload my project. What files do I need to include? The entire project folder?

Yes, That would be a start.

Some kind soul helped me by email. They said this:

Quote:

---

Move the Dim of Txt() to the module level rather than in the Sub and the problem goes away.

---

The first time I click Generate, it works. The second time I get the following error:

Error 10(This array is fixed or temporarily locked) in prodecure Command2_Click of Form Form1. Error on line number 0.

You can see where I placed the Dim Txt(). Hope its in the right place.

VB Code:

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any _
) As Long
 
Dim Txt() As MyData 'stores our data
 
Private Type MyData
    tStr() As String
    Bounds As Long
    index As Long
End Type

Any ideas on this?

That's not going to solve your original problem and it just created a new one... The only way you are going to solve this is by total luck or by letting someone look at your project...

This is a VERY strange problem.

I just found that if you make txt a fixed array with something like

Private Txt(27) As MyData

and you eliminate the Redim-ing then you can click Command2 as many times as you like. Is that acceptable?

BTW, what is the code in Command2 supposed to do?

Aha!! If you remove the With blocks it works even if Txt is dynamic. In other words do the following. (I hope it's OK for me to post this code. If it's not then let me know and I'll delete it.)

VB Code:

Private Sub Command2_Click()
 
          Dim i As Long 'counter
          Dim dComb As String 'combination string
          Dim dOutput As String 'output string
          Dim UB As Long 'Ubound of the txt() array
    
          Dim Text1Count As Long, Text2Count As Long, Text3Count As Long, TotalTextCount As Long
    
10        On Error GoTo Command2_Click_Error
    
20        i = 0
30        dComb = ""
40        dOutput = ""
50        UB = 0
 
    
60        If Check1.Value = vbChecked And Len(Trim(Text1.Text)) <= 0 Then
70        MsgBox "Error: no data in column1"
80            Exit Sub
90        Else
100       If Check1.Value = vbChecked Then
110           Text1Count = GetLineCount(Text1)
120           Else
130           Text1Count = 1
140       End If
150       End If
 
160       If Check2.Value = vbChecked And Len(Trim(Text2.Text)) <= 0 Then
170       MsgBox "Error: no data in column2"
180           Exit Sub
190       Else
200       If Check2.Value = vbChecked Then
210           Text2Count = GetLineCount(Text2)
220           Else
230           Text2Count = 1
240       End If
250       End If
 
260       If Check2.Value = vbChecked And Len(Trim(Text3.Text)) <= 0 Then
270       MsgBox "Error: no data in column3"
280           Exit Sub
290       Else
300       If Check3.Value = vbChecked Then
310           Text3Count = GetLineCount(Text3)
320           Else
330           Text3Count = 1
340       End If
350       End If
    
360       TotalTextCount = Text1Count * Text2Count * Text3Count
    
    
370       UB = -1 'set to invalid
    
          'assign each textbox data to the dynamic array if checked
380       If Check1.Value Then
390           UB = UB + 1
400           ReDim Txt(UB)
              'With Txt(UB)
410               Txt(UB).tStr = Split(Text1.Text, vbCrLf)
420               Txt(UB).Bounds = UBound(Txt(UB).tStr)
              'End With
430       End If
440       If Check2.Value Then
450           UB = UB + 1
460           ReDim Preserve Txt(UB)
              'With Txt(UB)
470               Txt(UB).tStr = Split(Text2.Text, vbCrLf)
480               Txt(UB).Bounds = UBound(Txt(UB).tStr)
              'End With
490       End If
500       If Check3.Value Then
510           UB = UB + 1
520           ReDim Preserve Txt(UB)
              'With Txt(UB)
530               Txt(UB).tStr = Split(Text3.Text, vbCrLf)
540               Txt(UB).Bounds = UBound(Txt(UB).tStr)
              'End With
550       End If
    
560       If UB = -1 Then 'none selected so exit
570           Exit Sub
580       End If
    
590       ProgressBar1.Value = 0
600       ProgressBar1.Max = TotalTextCount 'Your Value
610       ProgressBar1.Min = 0
    
    
    
620       Do
630       ProgressBar1.Value = ProgressBar1.Value + 1
640       Debug.Print ProgressBar1.Value
650           For i = 0 To UB
                  'With Txt(i)
660                   If Len(Txt(i).tStr(Txt(i).index)) Then
670                       dComb = dComb & Txt(i).tStr(Txt(i).index) & " "
680                       Else
690                           dComb = vbNullString
700                           Exit For
710                   End If
                  'End With
720           Next i
  
730           For i = UB To 0 Step -1
                  'With Txt(i)
740                   Txt(i).index = Txt(i).index + 1
750                   If Txt(i).index > Txt(i).Bounds Then
760                       Txt(i).index = 0
770                   Else
780                       Exit For
790                   End If
                  'End With
800           Next i
810           If i = -1 Then 'we are done
                  'new
                  'ProgressBar1.Value = 0
820               Exit Do
830           End If
840           If Len(dComb) > 0 Then
850               dOutput = dOutput & Trim$(dComb) & vbCrLf
860               dComb = vbNullString
870           End If
          'MsgBox dOutput
880       Loop
900      Exit Sub
 
Command2_Click_Error:
 
910       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command2_Click of Form Form1" & vbCrLf & "Error on line number " & Erl
      'Resume Next
End Sub

Someone else wrote the code that does the Redim, so I am not sure of the effect of eliminating it.

The Command2 code is supposed to take values in each of 3 text boxes and append them to each other with all possible permutations (caveat: with textbox1 word coming before textbox2 etc).

Does having Txt(27) give me 28 locations to store data? I might have a list of 10,000 words that are used. Maybe if I did Txt(50,000) to cover for lots of keywords?

See my post #28 for a better solution.

Hey Martin, that worked! Thank you. :) Now I can actually use the thing. Really appreciate the help on this one. I was completely stumped.

One thing I notice about this bit of code is that if I load up one of the textboxes with 10,000 words, it starts to run the code but after about 10 seconds, the hourglass comes up and it hangs.

Am I using the wrong types of variables so I run out of space? Or any ideas?

Does this happen in the IDE? If so and if it's possible put in some test code in the IDE to Debug.Print the word # it is working on and see if it is making progress.

Where do these 10,000 words come from? A File? If so and you are still having a problem, send me the file and instructions on how you use it.

What's slowing you down are the string concatenations, and the line by line append to the rtb... since your gonna be storing all those values in memory anyway (in the rtb, texboxes, etc), might as well use arrays to store the values and transfer them as one batch to the rtb. Its a lot faster that way since you can skip access to object properties until you really need to do so.

I included some Doevents to address the "hang" issue, but these doevents will slow down processing.

VB Code:

Private Sub Command1_Click()
Dim sA() As String
Dim sB() As String
Dim sC() As String
Dim cntA As Long
Dim cntB As Long
Dim cntC As Long
Dim mulA As Long
 
Dim idx As Long
Dim idxUB As Long
 
   Frame1.Enabled = False
   Command1.Enabled = False
   ProgressBar1.Max = 400
   
   'load values....
   If Check1.Value = vbChecked Then
      Call GetArray("\data\text1.txt", sA)
      cntA = UBound(sA) + 1
   Else
      ReDim sA(0)
      cntA = 1
   End If
   
   If Check2.Value = vbChecked Then
      Call GetArray("\data\text2.txt", sB)
      cntB = UBound(sB) + 1
   Else
      ReDim sB(0)
      cntB = 1
   End If
   
   If Check3.Value = vbChecked Then
      Call GetArray("\data\text3.txt", sC)
      cntC = UBound(sC) + 1
   Else
      ReDim sC(0)
      cntC = 1
   End If
   
   idxUB = (cntA * cntB * cntC) - 1
   
   'create series
   If Check1.Value = vbChecked Then
      ReDim Preserve sA(idxUB)
      mulA = cntB * cntC
      For idx = idxUB To 0 Step -1
         ProgressBar1.Value = (idxUB - idx) * 100 \ idxUB
         If idx Mod 1000 = 0 Then DoEvents
         sA(idx) = sA(idx \ mulA)
      Next
   Else
      ReDim sA(idxUB)
      ProgressBar1.Value = 100
   End If
   
   If Check2.Value = vbChecked Then
      ReDim Preserve sB(idxUB)
      For idx = idxUB To 0 Step -1
         ProgressBar1.Value = ((idxUB - idx) * 100 \ idxUB) + 100
         If idx Mod 1000 = 0 Then DoEvents
         sB(idx) = sB((idx \ cntC) Mod cntB)
      Next
   Else
      ReDim sB(idxUB)
      ProgressBar1.Value = 200
   End If
 
   If Check3.Value = vbChecked Then
      ReDim Preserve sC(idxUB)
      For idx = idxUB To 0 Step -1
         ProgressBar1.Value = ((idxUB - idx) * 100 \ idxUB) + 200
         If idx Mod 1000 = 0 Then DoEvents
         sC(idx) = sC(idx Mod cntC)
      Next
   Else
      ReDim sC(idxUB)
      ProgressBar1.Value = 300
   End If
   
   'update sA()
   For idx = 0 To idxUB
      ProgressBar1.Value = ((idx * 100) \ idxUB) + 300
      If idx Mod 1000 = 0 Then DoEvents
      sA(idx) = sA(idx) & vbTab & sB(idx) & vbTab & sC(idx)
   Next
   Erase sB
   Erase sC
   
   RichTextBox1.Text = Join(sA, vbCrLf)
   Erase sA
   
   Command1.Enabled = True
   Frame1.Enabled = True
End Sub
 
Private Sub GetArray(ByVal RelPath As String, ByRef DestArray() As String)
Dim ff As Integer
   
   ff = FreeFile
   Open App.Path & RelPath For Input As #ff
      DestArray = Split(Input(LOF(ff), #ff), vbCrLf)
   Close #ff
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
   RichTextBox1.Text = ""
End Sub

Admittedly this could still be improved, such as using just one big array for the combinations rather than the three arrays above... I just also wanted to show you an alternative to creating the combinations by writing the serries rather than having recursive loops or having indices that jump around (indices that loop then wrap back to zero for each column as your currently doing).

eg. For (A,B,C) (x,y,z) (0,1)
You will have 6 A's, 6 B's and 6 C's for first column...
You will have repeating pattern 2 x's, 2 y's, 2 z's for second column...
and you will have 0 and 1 alternating for third column...

A,x,0
A,x,1
A,y,0
A,y,1
A,z,0
A,z,1
etc...

If I understand how you are generating your list in the richtextbox you would create 27 entries if there were 3 entries in each column of the input data (3 x 3 x 3 = 27). So if you had 9500 in column1 and 10 in column 2 and 10 in column 3 then you'd be trying to generate 950,000 entries ( 9500 x 10 x 10) which will be very slow no matter what method you use. I performed an experiment with that much data in your program and also adding a display counter each time dOutput was incremented. The counter showed that in fact the program does not hang up with that much data (at least in the IDE)but after 1 hr 15 minutes it had "only" generated 275,000 rows. My display counter slows down the process slightly but you should look into other methods like leinad31's (which I didn't try) if in fact you need to process that much data.

Actually, you can generate just a subset or even one combination with the index calculations above, bit slower than index increment but it allows direct access... you just need the source elements count, all possible combinations count, the source arrays, and the index nth combination.

eg. For (A,B,C), (x,y,z), (0,1)

VB Code:

sA() = Split("A,B,C", ",")
sB() = Split("x,y,z", ",")
sC() = Split("0,1", ",")
cntA = UBound(sA) = 3   'this is count of A,B,C
cntB = UBound(sB) = 3   'this is count of x,y,z
cntC = UBound(sC) = 2   'this is count of 0,1
 
idxUB = (cntA * cntB * cntC) - 1  'all possible combinations adjusted by -1 for zero bound array
idxUB = (3*3*2) - 1  = 17  '18 combinations in array indices 0-17
 
'Combination at index 13 (14th combination) would then be:
Debug.Print sA(13 \ (cntB * cntC)) & vbTab & sB((13 \ cntC) Mod cntB) & vbTab & sC(idx) = sC(13 Mod cntC)
'or Debug.Print sA(13 \ 6) & vbTab & sB((13 \ 2) Mod 3) & vbTab & sC(13 Mod 2)
'or Debug.Print sA(2) & vbTab & sB(6 Mod 3) & vbTab & sC(1)
'or Debug.Print sA(2) & vbTab & sB(0) & vbTab & sC(1)
 
'WHERE sA(2) = 'C', sB(2) = 'x', sC(1) = '1'

So for 950,000 entries, you could split that up into 100k subsets (index 0-99999, 99999-199999, etc)

Sorry guys, I made a mistake. What I thought was the program hanging was in fact a huge slowdown that happens when the numbers get larger. It seems to be a disproportionate slowdown. Consequently, I will have to change the main routine.

leinad31, thank you for the coding you did. I tried to get it working but couldn't. Are you storing the data in a text file or something as opposed to the Textboxes?

Please remember that in an intensive loop if you dont use DoEvents your cpu will go to 100% usage and slow down all operations on your computer.

Quote:

---

Originally Posted by Jon12345

Sorry guys, I made a mistake. What I thought was the program hanging was in fact a huge slowdown that happens when the numbers get larger. It seems to be a disproportionate slowdown. Consequently, I will have to change the main routine.

leinad31, thank you for the coding you did. I tried to get it working but couldn't. Are you storing the data in a text file or something as opposed to the Textboxes?

---

Yes I'm using text files... it doesn't matter if its originally in a text file or a textbox... what's important is transfering the list to single dimension string arrays (eg. sA(), sB(), sC()... if there's no data then redim array to ubound zero such as ReDim sA(0)... sA(0) would contain "" by deault)...

post #36 explains how you can generate a particular combination based on these source arrays. Note that the source arrays are not resized unlike in post #34, you just get relevant elements from the sources... you could then transfer to one huge ReDim destination_Array(idxUB), rather than three huge cause of resize source arrays.

post #34 created the combinations per column... I reused the source arrays by resizing them to the number of combinations (ReDim Preserve sA(idxUB))... I then updated "" values in array by copying elements from portion of array with values (from array index 0 to cntA - 1), hence the decrement loops.

leinad31, I got it working and it is so much faster. A big thank you and repped. :)