+ Reply to Thread
Results 1 to 6 of 6

I need faster code

Hybrid View

Guest I need faster code 08-16-2007, 11:36 AM
Leith Ross Hello Mpeplow, It would be... 08-16-2007, 12:54 PM
Guest I'm sorry, I don't quite... 08-16-2007, 04:10 PM
Leith Ross Hello Mpeplow, Do you need... 08-16-2007, 04:33 PM
Guest yes! The macro is being... 08-16-2007, 04:43 PM
Leith Ross Hello Mpeplow, Try this... 08-16-2007, 05:30 PM
  1. #1
    mpeplow
    Guest

    Question I need faster code

    Does anyone have any suggestions on how to speed this up? I need it to be as fast as possible.

    Sub Find()
    
    Dim i As Long
    Dim x As Long
    
    Dim SS As Object
        Set SS = frmSearch.Spreadsheet1.Sheets("Data")
    Dim SearchData As String
    Dim NoSD As Long
        NoSD = SS.Range("A65536").End(xlUp).Row
    
    Dim FinalRow As Long
        FinalRow = Range("A65536").End(xlUp).Row
        
    For i = FinalRow To 2 Step -1
    DoEvents
        For x = 1 To NoSD
        DoEvents
            SearchData = SS.Range("A" & x).Value
            If Range("C" & i).Value = SearchData Then
                
                If frmOptions.chkBold = True Then 'Bold
                    Rows(i).Font.Bold = True
                End If
                
                If frmOptions.chkDeBoldText = True Then
                    Rows(i).Font.Bold = False
                End If
            
                If frmOptions.chkClear = True Then 'ClearContents
                    Rows(i).ClearContents
                End If
            
                If frmOptions.chkDelete = True Then 'Delete
                    Rows(i).Delete
                End If
            
                If frmOptions.chkHighlight = True Then 'Highlight
                    Rows(i).Interior.Color = vbYellow
                End If
                
                If frmOptions.chkNoFill = True Then
                    Rows(i).Interior.Color = xlNone
                End If
            End If
        Next x
        Application.StatusBar = "Working with line # " & i & " w/ criteria " & x
    Next i
    
    Application.StatusBar = False
    
    End Sub

  2. #2
    Forum Moderator Leith Ross's Avatar
    Join Date
    01-15-2005
    Location
    San Francisco, Ca
    MS-Off Ver
    2000, 2003, & 2010
    Posts
    23,259
    Hello Mpeplow,

    It would be faster to call the basic If portions of your Find macro from the Change Event for each check box involved.

    Sincerely,
    Leith Ross

  3. #3
    mpeplow
    Guest
    Quote Originally Posted by Leith Ross
    Hello Mpeplow,

    It would be faster to call the basic If portions of your Find macro from the Change Event for each check box involved.

    Sincerely,
    Leith Ross

    I'm sorry, I don't quite follow you. Could you show me or point me to an example please?

    Thank You

  4. #4
    Forum Moderator Leith Ross's Avatar
    Join Date
    01-15-2005
    Location
    San Francisco, Ca
    MS-Off Ver
    2000, 2003, & 2010
    Posts
    23,259
    Hello Mpeplow,

    Do you need to do this as a "batch"? Say, the macro is being called from a command button?

    Thanks,
    Leith Ross

  5. #5
    mpeplow
    Guest
    yes! The macro is being called from a command button.

    i'm using s spreadsheet object on a form to list the value to search for and preform the selected action(s) when found.
    Last edited by mpeplow; 08-16-2007 at 04:45 PM.

  6. #6
    Forum Moderator Leith Ross's Avatar
    Join Date
    01-15-2005
    Location
    San Francisco, Ca
    MS-Off Ver
    2000, 2003, & 2010
    Posts
    23,259
    Hello Mpeplow,

    Try this version, and let me know what happens. Since I don't have the data you have, this macro hasn't been tested. Use a copy of your workbook to test it.

    Revised Macro Code
    Sub Find()
    
      Dim ActiveRng As Range
      Dim Cell As Range
      Dim DataCell As Range
      Dim SS As Object
      Dim NoSD As Range
      Dim SS As Object
      
        Set SS = frmSearch.Spreadsheet1.Sheets("Data")
          With SS
            Set NoSD = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
          End With
    
        With ActiveSheet
          Set ActiveRng = .Range("C2", .Cells(.Rows.Count, "C").End(xlUp))
        End With
        
        
          For Each DataCell In NoSD
            For Each Cell In ActiveRng
              If Cell.Value = DataCell.Value Then
                
                 With Cell
                   If frmOptions.chkClear = True Then 'ClearContents
                      .ClearContents
                      GoTo NextCheck
                   End If
            
                   If frmOptions.chkDelete = True Then 'Delete
                      .Delete
                      GoTo NextCheck
                   End If
                   
                   If frmOptions.chkBold = True Then 'Bold
                      .Font.Bold = True
                   End If
                   
                   If frmOptions.chkDeBoldText = True Then
                      .Font.Bold = False
                   End If
                   
                   If frmOptions.chkHighlight = True Then 'Highlight
                      .Interior.Color = vbYellow
                   End If
                
                   If frmOptions.chkNoFill = True Then
                      .Interior.Color = xlNone
                   End If
                End With
                     
              End If
    NextCheck:
            Next Cell
          Next DataCell
    
    End Sub
    Sincerely,
    Leith Ross

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1