View Full Version : [SOLVED] Need help gettin this macro to run faster, Please!

estatefinds

03-06-2017, 11:02 AM

Option Explicit

[Sub test()

Dim g As Range, k As Range

Dim s, e

For Each g In Range("g1", Range("g1").End(xlDown))

For Each k In Range("k1", Range("k1").End(xlDown))

s = Split(g.Value, "-")

For Each e In Split(k.Value, "-")

s = Filter(s, e, False)

Next

If UBound(s) < 2 Then

Union(g, k).Interior.Color = vbRed

End If

Next

Next

End Sub]

so the data in G could have over 200,000 entries the data in column K over 400,000 entries.

how can this be written to run faster, I added the Application.Screenupdating =False so I can interrupt it by hitting hittinght ESC key but even that doesn't stop it when its running.

so toavoid doing this I need this to run faster

I appreciate any help on this!

Thank you

YasserKhalil

03-06-2017, 11:09 AM

Hello

Can you upload sample of your workbook?

And please put the codes between code tags

estatefinds

03-06-2017, 11:32 AM

will do Thank you:)

I'm not sure how you want the cells colored, but this is faster

Option Explicit

Sub test()

Dim G, K, Rg, Rk, s, e, x

Dim i As Long, j As Long, RgI As Long, RkI As Long

'Make and siz arrays

G = Range("g1", Range("g1").End(xlDown)).Value

K = Range("k1", Range("k1").End(xlDown)).Value

ReDim Rg(UBound(G))

ReDim Rk(UBound(K))

'Init Red Row Array indices

RgI = 1

RkI = 1

'Run filtering on arrays

For i = 1 To UBound(G)

For j = 1 To UBound(K)

s = Split(G(i), "-")

e = Split(K(j), "-")

For Each x In e

s = Filter(s, x, False)

Next

If UBound(s) < 2 Then

Rg(RgI) = i

Rk(RkI) = j

End If

Next

Next

'Set Cell Colors

Application.ScreenUpdating = False

RgI = 1

Do While Rg(RgI) <> 0

Range("G" & Rg(RgI)).Interior.Color = vbRed

RgI = RgI + 1

Loop

RkI = 1

Do While Rk(RkI) <> 0

Range("K" & Rk(RkI)).Interior.Color = vbRed

RkI = RkI + 1

Loop

Application.ScreenUpdating = True

End Sub

estatefinds

03-06-2017, 01:01 PM

ok I ran it but I get a run time error is this because I haven't added the enormous data to the existing file yet? the run time error is located at line

s = Split(G(i), "-")

so this is the instruction of how I want the cells colored.

I have Data in Column G in the form of combinations.

I need the Duplicate Macro to be restuctured to not only highlight the exact matches in column K but also to highlight the the data with at least 3 matching numbers within the combination, and four matching as well.

so for example G1 matches the data in K6 cause all 5 numbers match both would be highlighted.

in G2 with macro restuctured it would highlight it as it would match four of the numbers in K2 the 4-5-8-10

in the next example G10 the numbers 8-10-13 match the numbers in K9 cause the numbers 8-10-13 match.

Additional info.

the macro would start at at G1 highlight all matching based in the above description.

then it would continue to G2 and continue highlighting, Keep in mind once the data in column G and K is highlighted as the macro goes down the column anything highlighted will not be cleared, the ones allready highlighted will be skipped over as it is allready been highlighted.

estatefinds

03-06-2017, 02:53 PM

I keep getting the run time Error.

then i click debug and it highlifgts in yellow the part of code s = Split(G(i), "-")

can this be fixed?

estatefinds

03-07-2017, 06:58 AM

I put description in box five since you weren't sure of how I wanted highlighted "I'm not sure how you want the cells colored, but this is faster"

thank you for the work on code��

When I ran the code I got a run time error at line 18

the [s=Split(G(I), "-")]

Option Explicit

Sub test()

Dim gArr, gCel, kArr, kCel, Rg, Rk 'Arrays, "R" for Reds

Dim gArri As Long, gCeli As Long, Rgi As Long 'Indices

Dim kArri As Long, kCeli As Long, Rki As Long 'Indices

Dim Matches As Long

'Make and siz arrays

gArr = Range("g1", Range("g1").End(xlDown)).Value

kArr = Range("k1", Range("k1").End(xlDown)).Value

ReDim Rg(UBound(gArr))

ReDim Rk(UBound(kArr))

'Init Red Row Array indices

Rgi = 1

Rki = 1

'Run filtering on arrays

For gArri = 1 To UBound(gArr)

gCel = Split(gArr(gArri), "-")

For kArri = 1 To UBound(kArr)

Matches = 0

kCel = Split(kArr(kArri), "-")

For gCeli = 1 To UBound(gCel)

For kCeli = 1 To UBound(kCel)

If gCel(gCeli) = kCel(kCeli) Then Matches = Matches + 1

If Matches = 3 Then 'at least 3 in G = 3 in K

Rg(Rgi) = gArri

Rk(Rki) = kArri

GoTo NextkArr

End If

Next kCeli

Next gCeli

NextkArr:

Next kArri

Next gArri

'Set Cell Colors

Application.ScreenUpdating = False

Rgi = 1

Do While Rg(Rgi) <> 0

Range("G" & Rg(Rgi)).Interior.Color = vbRed

Rgi = Rgi + 1

Loop

Rki = 1

Do While Rk(Rki) <> 0

Range("K" & Rk(Rki)).Interior.Color = vbRed

Rki = Rki + 1

Loop

Application.ScreenUpdating = True

End Sub

estatefinds

03-07-2017, 08:34 AM

hello Thanks again

Im still getting run time error with

[gCel = Split(gArr(gArri), "-")]

Probably 'cuz that particular Cell in Column G doesn't contain a "-"

This should fix that issue

...

If Instr(gArr(gArri), "-") = 0 Then GoTo NextgArr

gCel = Split(gArr(gArri), "-")

For kArri = 1 To UBo...

Then place "NextgArr:", no quotes, before the line

Next gArri

The same fix will work if you get the same error at

kCel = Split(kArr(kArri), "-")

But the "NextkArr:" is already present

estatefinds

03-07-2017, 03:27 PM

does this [If Instr(gArr(gArri), "-") = 0 Then GoTo NextgArr gCel = Split(gArr(gArri), "-")

For kArri = 1 To UBo... ]

replace the {For gArri = 1 To UBound(gArr) gCel = Split(gArr(gArri), "-")

For kArri = 1 To UBound(kArr)]

estatefinds

03-08-2017, 06:02 AM

Im getting "Next with out for"

Message when I added the above as instructed.

need help getting this to work please.

Thank you

estatefinds

03-08-2017, 04:14 PM

So i rewrote the data making sure all data has the "-" within data and ran the origal code in box number 8 and i get the same "run time error '9': subscript out of range"

I again debug and the [ gCel = Split(gArr(gArri), "-")] is highlighted and cant figure out what is wrong.

Let me know if you can help me on this please

Sincerely

Thank you

Paul_Hossler

03-08-2017, 06:35 PM

After all the piecemeal changes from the posts, it might be better to post a new workbook with what your code looks like now and what is not working

estatefinds

03-08-2017, 07:16 PM

I have Data in Column G in the form of combinations.

I need the Duplicate Macro to be restuctured to not only highlight the exact matches in column K but also to highlight the the data with at least 3 matching numbers within the combination, and four matching as well.

so for example G1 matches the data in K6 cause all 5 numbers match both would be highlighted.

in G2 with macro restuctured it would highlight it as it would match four of the numbers in K2 the 4-5-8-10

in the next example G10 the numbers 8-10-13 match the numbers in K9 cause the numbers 8-10-13 match.

Additional info.

the macro would start at at G1 highlight all matching based in the above description.

then it would continue to G2 and continue highlighting, Keep in mind once the data in column G and K is highlighted as the macro goes down the column anything highlighted will not be cleared, the ones allready highlighted will be skipped over as it is allready been highlighted.

when i run the macro to do the above it comes up with error

Specifically "run time error '9': subscript out of range"

I again debug and the [ gCel = Split(gArr(gArri), "-")] is highlighted and I cant figure out what is wrong.

Paul_Hossler

03-09-2017, 12:26 PM

The way you filled gArri makes it a 2 dimensional array, so you need to refer to elements like this:

gCel = Split(gArr(gArri, 1), "-")

18585

estatefinds

03-09-2017, 03:23 PM

Ok so I placed the ,1 in the above as you did gCel = Split(gArr(gArri, 1), "-") and also did the same with the

kCel = Split(kArr(kArri), "-") and place the , 1 and it is running without error yet. once completed ill let you know if it is correct! Thank you ALL!!!!:)

Paul_Hossler

03-09-2017, 04:24 PM

I'm not sure that your sample data is correct

Option Explicit

Sub test_1()

Dim rG As Range, rK As Range

Dim aG As Variant, aK As Variant, aN As Variant

Dim aG5() As Variant, aK5() As Variant

Dim g As Long, k As Long, g1 As Long, k1 As Long, n As Long

'setup G's

Set rG = ActiveSheet.Cells(1, 7)

Set rG = Range(rG, rG.End(xlDown))

rG.Interior.ColorIndex = xlColorIndexNone

aG = Application.WorksheetFunction.Transpose(rG.Value)

ReDim aG5(LBound(aG) To UBound(aG))

For g = LBound(aG) To UBound(aG)

aG5(g) = Split(aG(g), "-")

Next g

'setup K's

Set rK = ActiveSheet.Cells(1, 11)

Set rK = Range(rK, rK.End(xlDown))

rK.Interior.ColorIndex = xlColorIndexNone

aK = Application.WorksheetFunction.Transpose(rK.Value)

ReDim aK5(LBound(aK) To UBound(aK))

For k = LBound(aK) To UBound(aK)

aK5(k) = Split(aK(k), "-")

Next k

'check

For g = LBound(aG) To UBound(aG)

For k = LBound(aK) To UBound(aK)

n = 0

For g1 = 0 To 4

For k1 = 0 To 4

If aG5(g)(g1) = aK5(k)(k1) Then

n = n + 1

Exit For

End If

Next k1

Next g1

If n >= 3 Then

rG.Cells(g).Interior.Color = vbRed

rK.Cells(k).Interior.Color = vbRed

End If

NextK:

Next k

NextG:

Next g

End Sub

estatefinds

03-09-2017, 07:46 PM

im getting run time error 13 type mismatch with this line

[ aK = Application.WorksheetFunction.Transpose(Rk.Value)]g

Paul_Hossler

03-09-2017, 08:40 PM

This line?

aK = Application.WorksheetFunction.Transpose(rK.Value)

I don't

estatefinds

03-10-2017, 01:58 AM

Yes [aK = Application.WorksheetFunction.Transpose(rK.Value) ]

I have over 7000 rows of data in Col G and over 400,000 rows of data in col K.

when I run it i get the run time error 13 mismatch at that line of code.

meaing when I debug it highlights that line of code.

estatefinds

03-10-2017, 04:19 AM

Yes [aK = Application.WorksheetFunction.Transpose(rK.Value) ]

i have 7000 rows of data in col G, and over 400,000 rows of data in col K.

I run code in box 18 no get run time error 13 type mismatch. Then when I debug it highlights the aK = Application.WorksheetFunction.Transpose(rK.Value)

Paul_Hossler

03-10-2017, 06:54 AM

Possilbly too much data or bad data (blanks, error message, etc.)

You'll have to post a workbook with just col G and K to see

estatefinds

03-10-2017, 07:07 AM

Ok. When I get home I will post. Thank you

estatefinds

03-10-2017, 07:19 AM

Ok I just reviewed it looks like too much data can this be fixed to work with this amount of data? I have other Macros that work with large data like this and haven't ran into to this type of error Before. Can we fix this?

Paul_Hossler

03-10-2017, 07:44 AM

Probably, but it's be easier if you attached a WB with the col G and K data as you have it

estatefinds

03-10-2017, 08:02 AM

Ok, thank you

estatefinds

03-10-2017, 03:03 PM

hello file is too big, there is a way you can test it,

open the file Code.xlsm and highlight and the grab bottom right corner of data and drag for instance, in the Column G drag down to 7000 rows, (this will just repeat the data to fill the rows) then do same with Column K drag down to 350,000 rows down then run and you ll see the error. let me know if you can see how we can fix it:)

estatefinds

03-11-2017, 08:12 AM

Did you have a chance to read #28?

Thank you

Paul_Hossler

03-11-2017, 05:51 PM

It seems TRANSPOSE has some limits

I changed macro to not use TRANSPOSE

Added a FillGK macro to populate 7000 and 350,000 entries in G and K

macro Match_1 seems to work, but takes awhile

Option Explicit

Sub FillGK()

Dim G As Range, K As Range

Dim i As Long

Set G = Range("G1").CurrentRegion

Set K = Range("K1").CurrentRegion

Application.ScreenUpdating = False

For i = 1 To 7000 \ G.Rows.Count

Application.StatusBar = "G -- " & i

G.Copy Range("G1").End(xlDown).Offset(1, 0)

DoEvents

Next i

For i = 1 To 350000 \ K.Rows.Count

Application.StatusBar = "K -- " & i

K.Copy Range("k1").End(xlDown).Offset(1, 0)

DoEvents

Next i

Application.StatusBar = False

End Sub

Option Explicit

Sub match_1()

Dim rG As Range, rK As Range

Dim aG As Variant, aK As Variant, aN As Variant

Dim aG5() As Variant, aK5() As Variant

Dim G As Long, K As Long, g1 As Long, k1 As Long, n As Long

'setup G's

Set rG = ActiveSheet.Cells(1, 7)

Set rG = Range(rG, rG.End(xlDown))

rG.Interior.ColorIndex = xlColorIndexNone

aG = rG.Value

ReDim aG5(LBound(aG, 1) To UBound(aG, 1))

For G = LBound(aG, 1) To UBound(aG, 1)

If G Mod 100 = 0 Then

Application.StatusBar = "Spliting G = " & Format(G, "#,##0")

DoEvents

End If

aG5(G) = Split(aG(G, 1), "-")

Next G

'setup K's

Set rK = ActiveSheet.Cells(1, 11)

Set rK = Range(rK, rK.End(xlDown))

rK.Interior.ColorIndex = xlColorIndexNone

aK = rK.Value

ReDim aK5(LBound(aK, 1) To UBound(aK, 1))

For K = LBound(aK, 1) To UBound(aK, 1)

If K Mod 100 = 0 Then

Application.StatusBar = "Spliting K = " & Format(K, "#,##0")

DoEvents

End If

aK5(K) = Split(aK(K, 1), "-")

Next K

'check

For G = LBound(aG, 1) To UBound(aG, 1)

For K = LBound(aK, 1) To UBound(aK, 1)

If K Mod 100 = 0 Then

Application.StatusBar = "Checking G = " & Format(G, "#,##0") & " -- K = " & Format(K, "#,##0")

DoEvents

End If

If aG5(G)(4) < aK5(K)(0) Then GoTo NextK ' largest G < smallest K

If aG5(G)(0) > aK5(K)(4) Then GoTo NextK ' smallest G > largest K

n = 0

For g1 = 0 To 4

For k1 = 0 To 4

If k1 = 3 And n <= 2 Then Exit For ' not enougth left

If aG5(G)(g1) = aK5(K)(k1) Then

n = n + 1

If n >= 3 Then ' Found 3 so mark and get out

rG.Cells(G).Interior.Color = vbRed

rK.Cells(K).Interior.Color = vbRed

Exit For

End If

End If

Next k1

Next g1

NextK:

Next K

NextG:

Next G

End Sub

estatefinds

03-12-2017, 10:01 AM

Hello I just finished running it it runs good except for:

now is the Macro only for example: looking at column G at first combination in Cell and then looks in Column K for just 3 matching numbers within the cell?

cause it looks as if it isnt searching for the 4 numbers matching in the cell of that combination nor high lighting the 5 numbers that match that combination.

so the 5-11-15-25-30 in column G is found in Column K but not highlighted, and all 5 numbers match.

so for example it the first combination matches all five numbers of column G to the 5 matching in column K it will highlight, then it will all search if there are 4 matching numbers within the cell in column G that is found in column K it will highlight those cells. and finally if there are at least 3 matching it will highlights those as well.

can this macro be adjusted?

Thank you very much for the hard work on this! I give you much Credit on your skills on this!

Paul_Hossler

03-13-2017, 07:28 AM

I'll check

I thought that if there were 3 matches, then no point in looking farther since if would be highlighted because of the 3

estatefinds

03-13-2017, 11:47 AM

Ok great! So since the 3 matches are colored it will look for what ever 4 matches are left uncolored and highlight if there are matches ,then the 5 matching that's left over uncolored will get highlighted if matched ; just like how the 3 work, but it will be in one code. Thank you very much!!!

estatefinds

03-15-2017, 06:01 AM

Hello, how is it coming along?

So the macro would work as it does in #30. The macro, Sub match_1(), the matching 3 numbers runs, Then would run like original code but now seeking the 4 matching numbers of the remaining uncolored combinations , then when that's done it will run for the 5 matching , the run for remaining uncolored ones left over that match.

Thank you very much for your help on this!

Paul_Hossler

03-15-2017, 08:27 AM

Been busy with the grandkids

I'll look tonight

estatefinds

03-15-2017, 09:41 AM

No problem, Thank you:)

Paul_Hossler

03-16-2017, 11:24 AM

I tried some test data and it seems to catch the 3, 4, and 5 'matches'

The logic is that if the macro finds 3, there's no point in continuing to look for 4 or 5

Look at my made up test data on SHEET2 and see if you can spot a flaw

18665

estatefinds

03-16-2017, 04:43 PM

i looked at it G15 and K4 is a 5 number match, is that the the flaw? its highlighted in g and k so it looks correct.

Really cant spot a flaw so far.

Paul_Hossler

03-17-2017, 08:38 AM

i looked at it G15 and K4 is a 5 number match, is that the the flaw? its highlighted in g and k so it looks correct.

Really cant spot a flaw so far.

I specifically put in some known 3, 4, and 5 matches to test and marked them

I filled in the rest so there might be a coincidental match that I did not mark

Keep looking

estatefinds

03-17-2017, 02:55 PM

The only thing i see is that the column K is shorter than column G

Also I saw

22-5-14-25-32 was not smallest to largest left to right

estatefinds

03-18-2017, 03:23 PM

I ran it and i got the run time error messge again I did the Debug and it highlited the

[aK = Application.WorksheetFunction.Transpose(rK.Value)]

Run-time error'13':

type mismatch

I guess th transpose has a limit of over 65000 rows, can this be overcome? it worked without transpose on the 3 matching how can we get it to work with the 4 matches and 5 matches?

Ichecked all my data and nothng is wrong with it but everytime the transpose ised i get this error, im stuck and baffled.

can this be fixed please? :)

Paul_Hossler

03-18-2017, 04:40 PM

Post #30 has version 3

I think I messed up and attached version 2 to the last post -- ver 2 has TRANSPOSE in it, ver 3 does not

Sorry for the confusion

estatefinds

03-18-2017, 05:26 PM

No problem! Thank you! I'm running it now, I'll let you know how it did! Thank you very much for your hard work on this! I very much appreciate it!!!:)

estatefinds

03-19-2017, 06:30 AM

Ok I just finished running it it looks like its doing the 3 matching and 4 matching,Which is great!, correction I did a search of 4 matching numbers and they werent highlighted mor were the % matching.

it needs to also besides the 3 matches do the 4 matches and 5 matches

to highlight and 5 matching.

can a code be added to the existing code to finish highlighting the matching 4 and matching 5?

Please?

Thank you sincerely

p.s.

is there a way when the macro for the 3 matches are done it will activate the next macro to run for the 4 matches of the remaining unhighlighted combinations, then when the four matching macro is done it will activate the macro for the remaning of the unhighlighted for the 5 matches?

estatefinds

03-24-2017, 01:45 PM

Hello, how are ya? And luck with #44?

Paul_Hossler

03-24-2017, 02:06 PM

Sorry - been busy with grandkids and the cold they gave me

I took out some checks that were intended to improved the speed, but seemed to cause problems

Try this with real data

If there's an issue, let me know the number(s)

p45cal

03-25-2017, 05:33 AM

I've made some tweaks to Paul's code in the attachment to msg#46, none of which will contribute to speeding things up(!) but might be of interest, perhaps even useful.

What it does is to add a couple more columns of information; you'll see them as plus signs in columns N and D. The idea being for you to select one of those cells and click Trace Precedents in the Formulas tab of the ribbon and it will show you which cells are matching. Double-clicking a blue line will toggle the selection to each end of the line. There are some comments in the code.

See attachment.

estatefinds

03-25-2017, 06:08 PM

Ok I ran it and ran into error due to memory so I'm freeing space and will run again and let you know how it worked! Thank you!��

estatefinds

03-25-2017, 06:10 PM

No problem, I know how that is! Thank you! I'm running again! I'll let you know! Thank you!��

p45cal

03-25-2017, 06:35 PM

What, in words, are you actually wanting to do?

estatefinds

03-25-2017, 10:29 PM

Ok so I ran macro and it colored all the 3 matching data of col G of column K then the four matching but it stopped and didn't complete all the 5 matching. I got the run time error '14': out of string space.

p45cal

03-26-2017, 05:40 AM

Presumably you ran the code in my attachment to message#47 and it worked?

All the matchings (3,4 & 5) are done in one pass.

If you're trying it on repeating data (there will be if your suggestion of copying down the values is followed in msg#28) there will be thousands of matches; a formula to include all the references will be long - very long. Typically,what's the largest number of matches one cell might you expect? I can limit the length of the formulae to say 3200 characters which will mean not all the matches will be pointed to when you Trace Precedents on the plus sign (all matches will still be coloured), but there'll be room for several hundred. It may be that you only need one column of references to matches rather than 2 (or none)?

I may be wasting my time, because, for example, you may be disinterested in the matches, and only interested in the non-matches, I don't know.

So again, what, in words, are you actually wanting to do?

estatefinds

03-26-2017, 07:20 AM

So the data in the K column is all possible combinations of numbers this is a set list and won't change,350,000 of them the data in column G are data of combinations that will match one of the ones in column K. Currently there are almost 8000 of these where one of combination will match the one in column K, eventually all will match as the list in column G gets bigger. What I wanted was to look at first combination in column G and looks for its match in column K and highlight both cause all Five numbers match. We could stick with just 5 matching for now and use the code without the 3 and 4 matching as this doesn't work well as I thought which Paul mentioned earlier. If we can just remove the part of code to that searches for 3 matching and 4 matching, and stick with just 5 matching but keep everything else including the trace precedents, etc.

I appreciate the work everybody has done on this!!!

Thank you sincerely,

Dennis

p45cal

03-26-2017, 07:42 AM

So the data in the K column is all possible combinations of numbers this is a set list and won't change,350,000 of them

This could make things a lot easier; all combinations of 5 numbers picked from 1 to 36 (=376992 combinations)? Can they be in order, top to bottom of the list?

estatefinds

03-26-2017, 08:40 AM

1to 35. The numbers I have in the column K I allready have in order from top to bottom, the numbers in column G are random as they become avail. The combinations themselves are in order from smallest to greatest left to right in the cell.

p45cal

03-26-2017, 10:26 AM

It's taking about 7 seconds per entry in column G on my old desktop, but this is using the brute force method of going through all the 324k cells in column K. If you have, say 70k cells in column G that would take some 5 or 6 days.

I do have some ideas about shortening the process; if you have a sequence like 10-12-14-16-18 in a cell in column G, there's no need to look for matches in any column K cells in the sheet above those beginning 10-. If you're looking for 3 number matches or more, there's no need to look below cells in column K starting with the third largest value which is 14-.

In your msg#15 'additional info' you talk of skipping over already highlighted cells in column K; I'm thinking it might be possible to code for this too.

Is there any point in highlighting cells in column G? There always going to match something (well, 4501 matches to be exact, in the case of 3-,4- and 5-number matches).

There could be 2 reasons I guess that you might want to highlight cells in column G:

1. To show that it has been processed; this could be used so that when you add data to column G, you only process unhighlighted cells when the code runs. This would considerably shorten subsequent runs.

2. I haven't worked this out yet: as more and more values get added to column G, and more and more cells in column K are highlighted, there might come a time when a new value in column G causes no more cells in column K to be highlighted, in which case, would you want to show that by not highlighting the cell in column G (or highlighting it in a different way)?

3. I might ditch the Trace Precedents thing as it's probably not sensble to have 4501 cell references in a formula in one cell, as well as it being nigh on impossible to discern the 4501 resulting blue lines! That should reduce time too.

Could you comment on/answer points 1 and 2 above?

estatefinds

03-26-2017, 10:58 AM

ok for number 1. yes on this number 1.to show that is has been processed.

The number 2. actually the numbers in column G that get added will be found in Column K when we use the the search for the 5 matches.

the code for the 3 and 4 matches will be removed completely, but be used for the 5 matches only.

so all the combinations in column K are unique they never repeat. so when the combinations in Column G get added it will match a combination in column K. we can ditch the Trace Precedents. so if we can will go ahead with code for the 5 matches only.

I am still working on the idea of the 3 and 4 in which i will post a new post once i figure exactly how I need it to work.

Thank you!!!

Paul_Hossler

03-26-2017, 11:12 AM

I've made some tweaks to Paul's code in the attachment to msg#46, none of which will contribute to speeding things up(!) but might be of interest, perhaps even useful.

What it does is to add a couple more columns of information; you'll see them as plus signs in columns N and D. The idea being for you to select one of those cells and click Trace Precedents in the Formulas tab of the ribbon and it will show you which cells are matching. Double-clicking a blue line will toggle the selection to each end of the line. There are some comments in the code.

See attachment.

This wasn't a 'tweak' -- it was a bug fix -- good catch for you, bad thinking for me

' If aG5(G)(4) < aK5(K)(0) Then GoTo NextK ' largest G < smallest K 'these are text comparisons!

' If aG5(G)(0) > aK5(K)(4) Then GoTo NextK ' smallest G > largest K 'these are text comparisons!

Paul_Hossler

03-26-2017, 11:17 AM

From post #15

I have Data in Column G in the form of combinations.

I need the Duplicate Macro to be restuctured to not only highlight the exact matches in column K but also to highlight the the data with at least 3 matching numbers within the combination, and four matching as well.

so for example G1 matches the data in K6 cause all 5 numbers match both would be highlighted.

in G2 with macro restuctured it would highlight it as it would match four of the numbers in K2 the 4-5-8-10

It seems to me that if you have 3 matches then you could highlight the paired cells and not bother to check for 4 or 5 matches

There doesn't seem to be any requirement to differentiate between the number of matches

Am I missing something?

estatefinds

03-26-2017, 11:28 AM

just need to focus on the 5 mathes for now:)

I have to come up with a differenet method of the 3 's and 4's because it doesnt descriminate like i thought it might.

but if we can do for the 5 matches this would be great! thank you!

Paul_Hossler

03-26-2017, 12:39 PM

Matching 5 is easy and fast

This seems to work on my test data

Also assumes that there can be multiple K values for each G value

Option Explicit

Sub match_5()

Dim rG As Range, rK As Range

Dim G As Long, K As Long, n As Long

Application.ScreenUpdating = False

'setup G's

Set rG = ActiveSheet.Cells(1, 7)

Set rG = Range(rG, rG.End(xlDown))

rG.Interior.ColorIndex = xlColorIndexNone

'setup K's

Set rK = ActiveSheet.Cells(1, 11)

Set rK = Range(rK, rK.End(xlDown))

rK.Interior.ColorIndex = xlColorIndexNone

For G = 1 To rG.Rows.Count

If G Mod 100 = 0 Then Application.StatusBar = "Processing G row " & Format(G, "#,##0")

Set rK = ActiveSheet.Cells(1, 11)

Set rK = Range(rK, rK.End(xlDown))

n = 0

On Error Resume Next

n = Application.WorksheetFunction.Match(rG.Cells(G, 1), rK, 0)

Do While n > 0

rG.Cells(G, 1).Interior.Color = vbRed

rK.Cells(n, 1).Interior.Color = vbRed

Set rK = rK.Cells(n + 1, 1)

Set rK = Range(rK, rK.End(xlDown))

n = 0

n = Application.WorksheetFunction.Match(rG.Cells(G, 1), rK, 0)

Loop

On Error GoTo 0

Next G

Application.StatusBar = False

Application.ScreenUpdating = True

End Sub

estatefinds

03-26-2017, 05:18 PM

just need to focus on the 5 mathes for now:)

I have to come up with a differenet method of the 3 's and 4's because it doesnt descriminate like i thought it might.

but if we can do for the 5 matches this would be great! thank you!

Paul_Hossler

03-26-2017, 05:57 PM

Well, try the macro above with lots of real live data and see how fast and accurate it is

p45cal

03-27-2017, 01:23 PM

On the only sheet in the attached workbook are 3 buttons:

1. In the vicinity of cell T1: Click to populate column K with all possible combinations of the numbers 1 to 35 in sets of 5. This is just to keep the file size small for attaching. Here, it takes less than a minute to run. Every cell is unique.

2. A button labelled '1.' This matches only the 5 numbers, in sequence, taking a leaf from Paul's procedure. It assumes all cells in column G contain 5 numbers, ascending left to right. When run it adds hyperlinks to columns G and K; click on a cell in column G and it takes you to a cell in column K. Click that cell in column K and it takes you back to the cell in column G. This assumes no repeats in column G. If there are repeats, clicking a cell with a hyperlink in column K takes you to the first cell with that combination in column G. The hyperlinks are obvious from their colour and underlining (the exact highlighting can be tweaked). This is the only way that the cells are highlighted in this procedure. It's quite quick. It requires all cells in column G to have ascending numbers left to right. If this is not the case, then the cell in column G is coloured grey (well, the sequence not found in column K).

3. A button labelled 2. This checks for matches of 3 and 4 numbers (not 5 numbers). It is slow. Here, about 7 seconds per cell in column G. It colours the cells, and adds formulae to column N to allow Trace Precedents. I've ditched that for column G.

Both buttons 1. and 2. ask if you want to clear things; if you say 'yes', highlighting or hyperlinks are removed and the data is treated as never having been processed. The idea is to save time by skipping over already-processed cells when you add data to column G by saying 'no' to the question.

Paul_Hossler

03-27-2017, 03:10 PM

I'm really confused -- where did the 'All combinations of 5 from 35" come from?

The Col K data sample in post #1 just looked random

18788

If that's the case, you could sort col g and just go down col K once

p45cal

03-27-2017, 03:34 PM

I'm really confused -- where did the 'All combinations of 5 from 35" come from?

The Col K data sample in post #1 just looked random

If that's the case, you could sort col g and just go down col K onceIt came from message#53:

So the data in the K column is all possible combinations of numbers this is a set list and won't change,350,000 of them the data in column G are data of combinations that will match one of the ones in column K. Currently there are almost 8000 of these where one of combination will match the one in column K, eventually all will match as the list in column G gets bigger.and from msg#55:

1to 35. The numbers I have in the column K I allready have in order from top to bottom, the numbers in column G are random as they become avail. The combinations themselves are in order from smallest to greatest left to right in the cell.which was an answer to my query:

all combinations of 5 numbers picked from 1 to 36 (=376992 combinations)? Can they be in order, top to bottom of the list?

p45cal

03-27-2017, 03:45 PM

If that's the case, you could sort col g and just go down col K onceYes indeed! For 5-number matches, an adaptation of your code in msg#61 would need only one pass and likely be very quick. Not so sure about looking for 3- and 4-number matches though.

p45cal

03-27-2017, 03:56 PM

By the way, this is flawed logic:

if you have a sequence like 10-12-14-16-18 in a cell in column G, there's no need to look for matches in any column K cells in the sheet above those beginning 10-.You could for example find a three-number match in 1-10-12-14-18, which comes way before 10-?-?-?-?

This next bit seems to hold though:

If you're looking for 3 number matches or more, there's no need to look below cells in column K starting with the third largest value which is 14-.but I didn't use it because stopping the search when 4500 3- and 4- number matches had been found was both easier to code and quicker.

Paul_Hossler

03-27-2017, 06:01 PM

OK, I'm still confused

If Col K consists of all 324,632 combinations from 1-2-3-4-5 to 31-32-33-34-35, it would seem that ANY Col G will have a match since G's 5 numbers will be guaranteed to be in Col K

So why worry about matching 3 and 4,

OR

Is it to 'fill in' more Col K entries with the 3 and 4's?

So a G = "10-20-30-31-32" would 'fill in' Col K all triplets that can be made of the 5 G pieces, e.g. any K with

10, 20, and 30 somewhere in it

10, 20, and 31 somewhere in it

10, 20, and 32 somewhere in it

20, 30, and 31 somewhere in it

20, 30, and 32 somewhere in it

30, 31, and 32 somewhere in it

estatefinds

03-27-2017, 07:13 PM

JoinedFeb 2016Posts270Locationhttp://www.vbaexpress.com/forum/images/flags/United%20States%203D.gif http://www.vbaexpress.com/forum/images/flags/states/Connecticut%203D.gif

just need to focus on the 5 mathes for now:)

I have to come up with a differenet method of the 3 's and 4's because it doesnt descriminate like i thought it might.

but if we can do for the 5 matches this would be great! thank you!

p45cal

03-27-2017, 09:09 PM

just need to focus on the 5 mathes for now You've already had that, twice, from Paul in msg#61 & from me in msg#64.

p45cal

03-28-2017, 03:06 AM

OK, I'm still confused

If Col K consists of all 324,632 combinations from 1-2-3-4-5 to 31-32-33-34-35, it would seem that ANY Col G will have a match since G's 5 numbers will be guaranteed to be in Col KI had a similar question a few messages ago:

Is there any point in highlighting cells in column G? There always going to match something (well, 4501 matches to be exact, in the case of 3-,4- and 5-number matches).and I droned on about it possibly being to record that the cell had been processed.

Certainly, it would be a help to know what the aims of the OP are - I have asked, twice, but haven't yet had a proper answer.

OR

Is it to 'fill in' more Col K entries with the 3 and 4's?I wish I knew…

So a G = "10-20-30-31-32" would 'fill in' Col K all triplets that can be made of the 5 G pieces, e.g. any K with

10, 20, and 30 somewhere in it

10, 20, and 31 somewhere in it

10, 20, and 32 somewhere in it

20, 30, and 31 somewhere in it

20, 30, and 32 somewhere in it

30, 31, and 32 somewhere in italong with (I think) the non-contiguous values:

10,30,31

10,30,32

10,31,32

20,31,32

for the triplets[, and

10,20,30,31

10,20,30,32

10,20,31,32

10,30,31,32

20,30,31,32

for the quadruplets.]

Your code already handles that admirably.

Paul_Hossler

03-28-2017, 05:41 AM

along with (I think) the non-contiguous values:

I think so also. I guess I was typing on the fly

Paul_Hossler

03-28-2017, 09:01 AM

I tried bit mapping, using internal arrays, and a K-col starting position for speed

Also colored the K matches green, yellow, cyan for 5, 4 and 3 matches

I delete the K's from 2000 on to be able to upload it, but p45cal's 'build' sub is in the attachment also

Option Explicit

Dim P2(0 To 31) As Long

Dim aG() As Long, aK() As Long, aKstart(1 To 35) As Long

Sub ph_match_5()

Dim rG As Range, rK As Range

Dim G As Long, K As Long, n As Long, i As Long, iKstart As Long

Dim v As Variant

Application.ScreenUpdating = False

'set powers of 2 array. skip 31 because that's sign bit

P2(0) = 1

For i = LBound(P2) + 1 To UBound(P2) - 1

P2(i) = 2 * P2(i - 1)

Next i

'setup G's

Set rG = ActiveSheet.Cells(1, 7)

Set rG = Range(rG, rG.End(xlDown))

rG.Interior.ColorIndex = xlColorIndexNone

ReDim aG(1 To rG.Rows.Count, 1 To 4)

ReDim aGLowHigh(1 To rG.Rows.Count, 1 To 2)

'setup K's

Set rK = ActiveSheet.Cells(1, 11)

Set rK = Range(rK, rK.End(xlDown))

rK.Interior.ColorIndex = xlColorIndexNone

ReDim aK(1 To rK.Rows.Count, 1 To 4)

ReDim aKLowHigh(1 To rK.Rows.Count, 1 To 2)

'build array of start of first element in K

For K = 1 To rK.Rows.Count

If K Mod 1000 = 0 Then

Application.StatusBar = "Building starting row of K, row " & Format(K, "#,##0")

DoEvents

End If

v = Split(rK.Cells(K, 1).Value, "-")

If aKstart(v(LBound(v))) = 0 Then aKstart(v(LBound(v))) = K

Next K

'map G's into bit array (1 - 16) into G(1), 17 - 32) into G(2), (33 - 48) into G(3), 49 - 64) into G(4)

'only using lower word (16 bits) to avoid negatives

For G = 1 To rG.Rows.Count

If G Mod 100 = 0 Then

Application.StatusBar = "Processing G bit maps, row " & Format(G, "#,##0")

DoEvents

End If

Call pvtStr2L1L2(rG.Cells(G, 1), aG(G, 1), aG(G, 2), aG(G, 3), aG(G, 4))

Next G

'map K's same way

For K = 1 To rK.Rows.Count

If K Mod 1000 = 0 Then

Application.StatusBar = "Processing K bit maps, row " & Format(K, "#,##0")

DoEvents

End If

Call pvtStr2L1L2(rK.Cells(K, 1), aK(K, 1), aK(K, 2), aK(K, 3), aK(K, 4))

Next K

'check for 3, 4 and 5 matches

For G = LBound(aG, 1) To UBound(aG, 1)

iKstart = CLng(Left(rG.Cells(G, 1).Value, InStr(rG.Cells(G, 1).Value, "-") - 1))

For K = aKstart(iKstart) To UBound(aK, 1)

If K Mod 1000 = 0 Then

Application.StatusBar = "Checking G = " & Format(G, "#,##0") & " against K = " & Format(K, "#,##0")

DoEvents

End If

If rK.Cells(K, 1).Interior.ColorIndex <> xlColorIndexNone Then GoTo NextK

n = 0

For i = LBound(aG, 2) To UBound(aG, 2)

n = n + pvtNumBits(aG(G, i), aK(K, i))

Next I

If n = 5 Then

rK.Cells(K, 1).Interior.Color = vbGreen

ElseIf n = 4 And rK.Cells(K, 1).Interior.ColorIndex = xlColorIndexNone Then

rK.Cells(K, 1).Interior.Color = vbYellow

ElseIf n = 3 And rK.Cells(K, 1).Interior.ColorIndex = xlColorIndexNone Then

rK.Cells(K, 1).Interior.Color = vbCyan

End If

NextK:

Next K

Next G

Application.StatusBar = False

Application.ScreenUpdating = True

End Sub

Private Sub pvtStr2L1L2(s As String, L1 As Long, L2 As Long, L3 As Long, L4 As Long)

Dim v As Variant, v1() As Long

Dim i As Long

v = Split(s, "-")

ReDim v1(LBound(v) To UBound(v))

For i = LBound(v) To UBound(v)

v1(i) = CLng(v(i))

Next I

L1 = 0

L2 = 0

L3 = 0

L4 = 0

For i = LBound(v1) To UBound(v1)

Select Case v1(i)

Case 1 To 16

L1 = L1 + P2(v1(i))

Case 17 To 32

L2 = L2 + P2(v1(i) - 16)

Case 33 To 48

L3 = L3 + P2(v1(i) - 32)

Case 49 To 64

L4 = L4 + P2(v1(i) - 48)

End Select

Next i

End Sub

Function pvtNumBits(L1 As Long, L2 As Long) As Long

Dim n As Long

Dim L3 As Long

Dim i As Long

n = 0

L3 = L1 And L2

For i = 0 To 15

If (L3 And P2(i)) <> 0 Then n = n + 1

Next I

pvtNumBits = n

End Function

estatefinds

03-29-2017, 04:55 PM

that worked great!!! Thank you!! and thanks everybody for helping me!!!

mdmackillop

03-30-2017, 03:27 AM

Hi Paul

Just looking at your solution, I get an error here

If rK.Cells(K, 1).Interior.ColorIndex <> xlColorIndexNone Then GoTo NextK

where debug shows K=0

Regards

MD

Paul_Hossler

03-30-2017, 05:16 AM

That will happen if you don't have Col K completely populated with all combinations (macro AllCombos)

The aKstart array has the starting point of the 1-...'s, 2-..., ...., 32-...

So without all the possibles, some of aKstart enteries are = 0

mdmackillop

03-30-2017, 05:50 AM

Thanks Paul

I ran it against the sample file but I see why you didn't post a whole sample!

MD

Paul_Hossler

03-30-2017, 12:41 PM

I think the bit mapping related logic is inelegant, so i'm working on a more elegant general purpose approach at least for my own purposes

Instead of

Dim P2(0 To 31) As Long

P2(0) = 1

For i = LBound(P2) + 1 To UBound(P2) - 1

P2(i) = 2 * P2(i - 1)

Next i

you can use

sn = [index(2^(row(1:31)-1),)]

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.