Consulting

Page 4 of 4 FirstFirst ... 2 3 4
Results 61 to 80 of 80

Thread: Need help gettin this macro to run faster, Please!

  1. #61
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  2. #62
    VBAX Mentor
    Joined
    Feb 2016
    Posts
    382
    Location
    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!

  3. #63
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Well, try the macro above with lots of real live data and see how fast and accurate it is
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #64
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.
    Attached Files Attached Files
    Last edited by p45cal; 03-27-2017 at 03:40 PM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #65
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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

    Capture.JPG

    If that's the case, you could sort col g and just go down col K once
    Last edited by Paul_Hossler; 03-27-2017 at 03:20 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #66
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by Paul_Hossler View Post
    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 once
    It came from message#53:
    Quote Originally Posted by estatefinds View Post
    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:
    Quote Originally Posted by estatefinds View Post
    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:
    Quote Originally Posted by p45cal View Post
    all combinations of 5 numbers picked from 1 to 36 (=376992 combinations)? Can they be in order, top to bottom of the list?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  7. #67
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by Paul_Hossler View Post
    If that's the case, you could sort col g and just go down col K once
    Yes 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
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #68
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    By the way, this is flawed logic:
    Quote Originally Posted by p45cal View Post
    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:
    Quote Originally Posted by p45cal View Post
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #69
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  10. #70
    VBAX Mentor
    Joined
    Feb 2016
    Posts
    382
    Location
    JoinedFeb 2016Posts270Location

    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!





  11. #71
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by estatefinds View Post
    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
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #72
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by Paul_Hossler View Post
    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
    I had a similar question a few messages ago:
    Quote Originally Posted by p45cal View Post
    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.





    Quote Originally Posted by Paul_Hossler View Post
    OR
    Is it to 'fill in' more Col K entries with the 3 and 4's?
    I wish I knew…




    Quote Originally Posted by Paul_Hossler View Post
    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
    along 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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  13. #73
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    along with (I think) the non-contiguous values:
    I think so also. I guess I was typing on the fly
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #74
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  15. #75
    VBAX Mentor
    Joined
    Feb 2016
    Posts
    382
    Location
    that worked great!!! Thank you!! and thanks everybody for helping me!!!

  16. #76
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  17. #77
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  18. #78
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Thanks Paul
    I ran it against the sample file but I see why you didn't post a whole sample!
    MD
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  19. #79
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  20. #80
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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),)]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •