Need help gettin this macro to run faster, Please!

[estatefinds]

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]

Hello
Can you upload sample of your workbook?
And please put the codes between code tags

[estatefinds]

will do Thank you

[SamT]

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]

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]

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]

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), "-")]

[SamT]

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]

hello Thanks again
Im still getting run time error with

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

[SamT]

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]

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]

Im getting "Next with out for"

Message when I added the above as instructed.

need help getting this to work please.
Thank you

[estatefinds]

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]

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]

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]

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), "-")

Capture.JPG

[estatefinds]

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]

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]

im getting run time error 13 type mismatch with this line

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

[Paul_Hossler]

This line?

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

I don't