vba for identifying strings of data and moving large sets of data

[tony0217]

i have this vba code that ive been working on since last year and i cant seem to run it without excel crashing when i add more data to it.
is there any way to tidy this up or make it run more efficiently (faster)?

i have 100 rows x 6 columns but sometimes up to 15 columns wide.

I just cant seem to speed it up. please help. thanks in advance.

Sub Permute()
Application.ScreenUpdating = False
Dim ix(100, 1) As Long, rc As Long, m As Long, br As Long, md As Variant, i As Long, r As Long
Dim str1 As String, r1 As Long, c1 As Long, element(100) As Variant


    rc = Cells(1, Columns.Count).End(xlToLeft).Column
    m = 0
    For i = 1 To rc
        br = Cells(Rows.Count, i).End(xlUp).Row
        If br > m Then m = br
        ix(i, 0) = br
        ix(i, 1) = 1
    Next i
    md = Range(Cells(1, 1), Cells(m, rc)).Value
    r = 0
Incr:
    str1 = ""
    For i = 1 To rc
        str1 = str1 & md(ix(i, 1), i)
        element(i) = md(ix(i, 1), i)
    Next i


MyCode:
    If Mid(element(1), 1, 1) = Mid(element(2), 1, 1) And _
    Mid(element(1), 1, 1) = Mid(element(3), 1, 1) And _
    Mid(element(2), 1, 1) = Mid(element(3), 1, 1) And _
    Mid(element(1), 2, 1) = Mid(element(4), 1, 1) And _
    Mid(element(1), 2, 1) = Mid(element(5), 1, 1) And _
    Mid(element(4), 1, 1) = Mid(element(5), 1, 1) And _
    Mid(element(2), 2, 1) = Mid(element(4), 2, 1) And _
    Mid(element(2), 2, 1) = Mid(element(6), 1, 1) And _
    Mid(element(4), 2, 1) = Mid(element(6), 1, 1) And _
    Mid(element(3), 2, 1) = Mid(element(5), 2, 1) And _
    Mid(element(3), 2, 1) = Mid(element(6), 2, 1) And _
    Mid(element(5), 2, 1) = Mid(element(6), 2, 1) Then _


        r = r + 1
        r1 = ((r - 1) Mod Rows.Count) + 1
        c1 = Int((r - 1) / Rows.Count) + 1
        Sheets("Sheet2").Cells(r1, c1) = str1
    End If
    
    For i = rc To 1 Step -1
        ix(i, 1) = ix(i, 1) + 1
        If ix(i, 1) <= ix(i, 0) Then Exit For
        ix(i, 1) = 1
    Next i
    If i > 0 Then GoTo Incr:
    
End Sub

 

[Fluff]

The code I supplied is based on your comments in post#4
If that's not what you want, then you'll need to modify this part of the code.

If Trim(Right(Ary(i, 1), 2)) = Trim(Left(Ary(i, 2), 2)) And _
         Trim(Left(Ary(i, 1), 2)) = Trim(Left(Ary(i, 3), 2)) And _
         Trim(Right(Ary(i, 2), 2)) = Trim(Right(Ary(i, 3), 2)) Then

 

[tony0217]

ok thats fair enough. Only thing is that im not sure which parts mean what.
Can i get an idea of the parts please?

 

[Fluff]

Will do, but first up, your code is only looking at 1 character, although in post#4 I got the impression that the numbers can go up to 99.
Do you just want to look at a single digit number, or a 2 digit number?

 

[tony0217]

ok, but i feel like im being confusing..
if you take the example data and place it in your spreadsheet like this and run
the code i have provided below you will see exactly what im trying to do.
i just need a way to make the code more efficient/faster





A B C D E F
[TABLE="width: 384"]
<colgroup><col width="64" span="6" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]94[/TD]
[TD="class: xl63, width: 64"]27[/TD]
[TD="class: xl63, width: 64"]19[/TD]
[TD="class: xl63, width: 64"]12[/TD]
[TD="class: xl63, width: 64"]56[/TD]
[TD="class: xl63, width: 64"]23[/TD]
[/TR]
[TR]
[TD="class: xl63"]81[/TD]
[TD="class: xl63"]53[/TD]
[TD="class: xl63"]58[/TD]
[TD="class: xl63"]19[/TD]
[TD="class: xl63"]65[/TD]
[TD="class: xl63"]81[/TD]
[/TR]
[TR]
[TD="class: xl63"]25[/TD]
[TD="class: xl63"]54[/TD]
[TD="class: xl63"]63[/TD]
[TD="class: xl63"]42[/TD]
[TD="class: xl63"]42[/TD]
[TD="class: xl63"]25[/TD]
[/TR]
[TR]
[TD="class: xl63"]17[/TD]
[TD="class: xl63"]92[/TD]
[TD="class: xl63"]11[/TD]
[TD="class: xl63"]72[/TD]
[TD="class: xl63"]22[/TD]
[TD="class: xl63"]62[/TD]
[/TR]
[TR]
[TD="class: xl63"]83[/TD]
[TD="class: xl63"]22[/TD]
[TD="class: xl63"]26[/TD]
[TD="class: xl63"]75[/TD]
[TD="class: xl63"]86[/TD]
[TD="class: xl63"]51[/TD]
[/TR]
[TR]
[TD="class: xl63"]92[/TD]
[TD="class: xl63"]20[/TD]
[TD="class: xl63"]12[/TD]
[TD="class: xl63"]91[/TD]
[TD="class: xl63"]78[/TD]
[TD="class: xl63"]37[/TD]
[/TR]
[TR]
[TD="class: xl63"]27[/TD]
[TD="class: xl63"]88[/TD]
[TD="class: xl63"]46[/TD]
[TD="class: xl63"]55[/TD]
[TD="class: xl63"]82[/TD]
[TD="class: xl63"]26[/TD]
[/TR]
[TR]
[TD="class: xl63"]68[/TD]
[TD="class: xl63"]66[/TD]
[TD="class: xl63"]88[/TD]
[TD="class: xl63"]79[/TD]
[TD="class: xl63"]45[/TD]
[TD="class: xl63"]48[/TD]
[/TR]
[TR]
[TD="class: xl63"]64[/TD]
[TD="class: xl63"]24[/TD]
[TD="class: xl63"]86[/TD]
[TD="class: xl63"]93[/TD]
[TD="class: xl63"]76[/TD]
[TD="class: xl63"]58[/TD]
[/TR]
[TR]
[TD="class: xl63"]41[/TD]
[TD="class: xl63"]99[/TD]
[TD="class: xl63"]85[/TD]
[TD="class: xl63"]o7[/TD]
[TD="class: xl63"]85[/TD]
[TD="class: xl63"]82[/TD]
[/TR]
[TR]
[TD="class: xl63"]87[/TD]
[TD="class: xl63"]60[/TD]
[TD="class: xl63"]40[/TD]
[TD="class: xl63"]98[/TD]
[TD="class: xl63"]39[/TD]
[TD="class: xl63"]40[/TD]
[/TR]
[TR]
[TD="class: xl63"]o9[/TD]
[TD="class: xl63"]43[/TD]
[TD="class: xl63"]56[/TD]
[TD="class: xl63"]13[/TD]
[TD="class: xl63"]70[/TD]
[TD="class: xl63"]44[/TD]
[/TR]
[TR]
[TD="class: xl63"]37[/TD]
[TD="class: xl63"]98[/TD]
[TD="class: xl63"]57[/TD]
[TD="class: xl63"]58[/TD]
[TD="class: xl63"]34[/TD]
[TD="class: xl63"]70[/TD]
[/TR]
[TR]
[TD="class: xl63"]50[/TD]
[TD="class: xl63"]58[/TD]
[TD="class: xl63"]60[/TD]
[TD="class: xl63"]27[/TD]
[TD="class: xl63"]95[/TD]
[TD="class: xl63"]59[/TD]
[/TR]
[TR]
[TD="class: xl63"]o4[/TD]
[TD="class: xl63"]75[/TD]
[TD="class: xl63"]50[/TD]
[TD="class: xl63"]38[/TD]
[TD="class: xl63"]44[/TD]
[TD="class: xl63"]88[/TD]
[/TR]
[TR]
[TD="class: xl63"]95[/TD]
[TD="class: xl63"]18[/TD]
[TD="class: xl63"]o1[/TD]
[TD="class: xl63"]47[/TD]
[TD="class: xl63"]53[/TD]
[TD="class: xl63"]28[/TD]
[/TR]
[TR]
[TD="class: xl63"]82[/TD]
[TD="class: xl63"]42[/TD]
[TD="class: xl63"]16[/TD]
[TD="class: xl63"]21[/TD]
[TD="class: xl63"]40[/TD]
[TD="class: xl63"]49[/TD]
[/TR]
[TR]
[TD="class: xl63"]86[/TD]
[TD="class: xl63"]34[/TD]
[TD="class: xl63"]35[/TD]
[TD="class: xl63"]70[/TD]
[TD="class: xl63"]51[/TD]
[TD="class: xl63"]20[/TD]
[/TR]
[TR]
[TD="class: xl63"]45[/TD]
[TD="class: xl63"]68[/TD]
[TD="class: xl63"]34[/TD]
[TD="class: xl63"]84[/TD]
[TD="class: xl63"]29[/TD]
[TD="class: xl63"]87[/TD]
[/TR]
[TR]
[TD="class: xl63"]56[/TD]
[TD="class: xl63"]55[/TD]
[TD="class: xl63"]55[/TD]
[TD="class: xl63"]85[/TD]
[TD="class: xl63"]13[/TD]
[TD="class: xl63"]27[/TD]
[/TR]
</tbody>[/TABLE]

Sub Permute()
Dim ix(100, 1) As Long, rc As Long, m As Long, br As Long, md As Variant, i As Long, r As Long
Dim str1 As String, r1 As Long, c1 As Long, element(100) As Variant


    rc = Cells(1, Columns.Count).End(xlToLeft).Column
    m = 0
    For i = 1 To rc
        br = Cells(Rows.Count, i).End(xlUp).Row
        If br > m Then m = br
        ix(i, 0) = br
        ix(i, 1) = 1
    Next i
    md = Range(Cells(1, 1), Cells(m, rc)).Value
    r = 0
Incr:
    str1 = ""
    For i = 1 To rc
        str1 = str1 & md(ix(i, 1), i)
        element(i) = md(ix(i, 1), i)
    Next i


MyCode:
    If Mid(element(1), 1, 1) = Mid(element(2), 1, 1) And _
    Mid(element(1), 1, 1) = Mid(element(3), 1, 1) And _
    Mid(element(2), 1, 1) = Mid(element(3), 1, 1) And _
    Mid(element(1), 2, 1) = Mid(element(4), 1, 1) And _
    Mid(element(1), 2, 1) = Mid(element(5), 1, 1) And _
    Mid(element(4), 1, 1) = Mid(element(5), 1, 1) And _
    Mid(element(2), 2, 1) = Mid(element(4), 2, 1) And _
    Mid(element(2), 2, 1) = Mid(element(6), 1, 1) And _
    Mid(element(4), 2, 1) = Mid(element(6), 1, 1) And _
    Mid(element(3), 2, 1) = Mid(element(5), 2, 1) And _
    Mid(element(3), 2, 1) = Mid(element(6), 2, 1) And _
    Mid(element(5), 2, 1) = Mid(element(6), 2, 1) Then _


        r = r + 1
        r1 = ((r - 1) Mod Rows.Count) + 1
        c1 = Int((r - 1) / Rows.Count) + 1
        Sheets("Sheet2").Cells(r1, c1) = str1
    End If
    
    For i = rc To 1 Step -1
        ix(i, 1) = ix(i, 1) + 1
        If ix(i, 1) <= ix(i, 0) Then Exit For
        ix(i, 1) = 1
    Next i
    If i > 0 Then GoTo Incr:
    
End Sub

You will see that there is only 1 permutation that is created from the list.
currently this takes over 20 minutes on my pc. not sure why lol

 

[Fluff]

I am now completely lost
I don't understand what your code & if it takes 20mins to run, I have no intention of running it to see what is happening.
That data looks nothing like the data in post#4 and from your description, plus looking at your code I cannot see a single row that full-fills your criteria?
Are you just trying to compare the numbers on each row together, or any sequence of numbers no matter where they are located?

 

[Fluff]

Ok, left your code running whilst I had something to eat & it completed 64 million checks in 14.8minutes.
That equates to 13.9 microseconds per calculation. I suspect you'll find it difficult to do that any quicker.

 

[tony0217]

Ok cool. so there's absolutely no way to run this anymore efficient? is the code only what is necessary to do the work?

 

[Fluff]

I'm afraid I know of no way to do what you are after any faster.

 

[Peter_SSs]

I preface my comments by saying that I have no idea what your code is doing. Your comment telling us to run the code and we will see what you are trying to do is not correct - at least it isn't for me.
I'll return to this at the end of my post.


I initially ran the data and code from post #14 . I didn't time it but I'd say similar time to Fluff.
I altered the code as shown below and it ran in less than 3 minutes (still seems slow to me but a significant improvement on 15-20 minutes.

The logic involves this line of code

  If Mid(element(1), 1, 1) = Mid(element(2), 1, 1) And _
    Mid(element(1), 1, 1) = Mid(element(3), 1, 1) And _
    Mid(element(2), 1, 1) = Mid(element(3), 1, 1) And _
    Mid(element(1), 2, 1) = Mid(element(4), 1, 1) And _
    Mid(element(1), 2, 1) = Mid(element(5), 1, 1) And _
    Mid(element(4), 1, 1) = Mid(element(5), 1, 1) And _
    Mid(element(2), 2, 1) = Mid(element(4), 2, 1) And _
    Mid(element(2), 2, 1) = Mid(element(6), 1, 1) And _
    Mid(element(4), 2, 1) = Mid(element(6), 1, 1) And _
    Mid(element(3), 2, 1) = Mid(element(5), 2, 1) And _
    Mid(element(3), 2, 1) = Mid(element(6), 2, 1) And _
    Mid(element(5), 2, 1) = Mid(element(6), 2, 1) Then _

It is doing 12 checks. If all 12 checks are True then 'something' happens. If any one of the checks is False then the code does not do that 'something'.
So, if the very first check of the 12 is False, why bother spending another 11 of those units of time checking the other 11?
My improvement then simply involves stopping the 12 checks as soon as any one of them fails. (If there was any one or a group of those checks more likely to fail, they should be the first ones done.)

The re-write of that section of code then becomes

MyCode:
  If Mid(element(1), 1, 1) = Mid(element(2), 1, 1) Then
    If Mid(element(1), 1, 1) = Mid(element(3), 1, 1) Then
      If Mid(element(2), 1, 1) = Mid(element(3), 1, 1) Then
        If Mid(element(1), 2, 1) = Mid(element(4), 1, 1) Then
          If Mid(element(1), 2, 1) = Mid(element(5), 1, 1) Then
            If Mid(element(4), 1, 1) = Mid(element(5), 1, 1) Then
              If Mid(element(2), 2, 1) = Mid(element(4), 2, 1) Then
                If Mid(element(2), 2, 1) = Mid(element(6), 1, 1) Then
                  If Mid(element(4), 2, 1) = Mid(element(6), 1, 1) Then
                    If Mid(element(3), 2, 1) = Mid(element(5), 2, 1) Then
                      If Mid(element(3), 2, 1) = Mid(element(6), 2, 1) Then
                        If Mid(element(5), 2, 1) = Mid(element(6), 2, 1) Then _
            
                          r = r + 1
                          r1 = ((r - 1) Mod Rows.Count) + 1
                          c1 = Int((r - 1) / Rows.Count) + 1
                          Sheets("Sheet2").Cells(r1, c1) = str1
            
                        End If
                      End If
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  End If

If that makes a similar improvement for you and is fast enough then that's great. However, if you wanted to still investigate if further improvements could be made, you will need to do a better job of explaining in both words and simple examples what you are trying to do. Perhaps an example with 3 columns and 5-10 rows if you can make a meaningful example from that.

In any case, can you explain why the result from the post 14 data is 272226727626?
Where in the data does that come from?
Also, in your sample data the letter "o" prefixes some of the digits. Is that correct or should they be zeroes? Is there any special significance to those characters?

 

[tony0217]

ok.
here is the way i should have explained the problem from the begining.
Im gonna keep it simple


all im doing is laying out all possible permutations that can be made,
and in between those permutations deciding to keep it or not based on all 12 matches returning a value of TRUE.
thats all.


its all about positioning.


there are four positions, A B C and D.


COLUMN A contains two of the four positions, A and B.
COLUMN B contains A and C.
COLUMN C contains A and D.
COLUMN D contains B and C
COLUMN E contains B and D.
COLUMN F contains C and D.


I then want to find the permutations where ALL the A's B's C's and D's match.
but they ALL must match to be kept ONLY.


If there is a 12 way match, I then want to paste that permutation on to sheet2 in column A, in the next available spot in the column.
if not, do not copy and continue to the next permutation.


I like the point you made about not going through all 64 million permutations, and
stopping once they dont match immediately. this is basically what i have been looking for.




I managed to make something so simple sound confusing.


I just want to go through all permutations and keep the ones that match
and get rid of the ones that dont.


the o's are special characters separate from the zeroes.


the permutation that makes up 272226727626 is because:


its the only permutation where all the A's, B's, C's and D's match perfectly.




AB AC AD BC BD CD
A7 B5 C5 D4 E9 F7
27 22 26 72 76 26


If you notice, all the A's are 2's
B's are 7's
C's are 2's and D's are 6's.


they all match.




the only one out of 64 million possibilities.


thats all.


and for some reason i could never seem to trim enough time off of it.


thank you.