CODEWITHSUNDEEP
vbaexcelruntime
Stupid_Intern
Stupid_Intern

Reputation: 3450

Can I make this code execution time shorter?

This code takes more than 10 seconds to finish. Is there a faster way to do this?

If a particular cell in a row consist of "H" character then hide the entire row and also explain the contents of the cell with a given background color here, it's index code is 19.

Option Explicit

Sub TailoredInputs()
Dim ws As Worksheet
Dim i, j, l As Integer

Set ws = Sheets("Inputs")
Application.ScreenUpdating = False

Range("A7:A200").EntireRow.Hidden = False

With ws
    .Select
    j = 10

    Do While j <= 149

        If .Cells(j, "J").Value = "H" Then
            For l = 4 To 9
                If .Cells(j, l).Interior.ColorIndex = 19 Then
                    .Cells(j, l).ClearContents
                 Else: End If
             Next l

            .Cells(j, "J").EntireRow.Hidden = True

        Else: End If

        If .Cells(j, "K").Value = "H" Then
            For l = 4 To 9
                If .Cells(j, l).Interior.ColorIndex = 19 Then
                    .Cells(j, l).ClearContents
                Else: End If
            Next l

            .Cells(j, "J").EntireRow.Hidden = True

        Else: End If 

        j = j + 1
    Loop   

    Range("Spendinginput").Select  

End With

Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 71

Answers (2)

Tim Williams
Tim Williams

Reputation: 166221

Untested:

Sub TailoredInputs()
    Dim ws As Worksheet
    Dim i, j, l As Integer, rngHide As Range

    Set ws = Sheets("Inputs")
    Application.ScreenUpdating = False

    ws.Range("A7:A200").EntireRow.Hidden = False

    For j = 10 To 149
        If ws.Cells(j, "J").Value = "H" Or ws.Cells(j, "K").Value = "H" Then
            For l = 4 To 9
                If ws.Cells(j, l).Interior.ColorIndex = 19 Then
                     ws.Cells(j, l).ClearContents
                End If
            Next l
            'build the range which will be hidden
            If rngHide Is Nothing Then
                Set rngHide = ws.Cells(j, 1)
            Else
                Set rngHide = Application.Union(rngHide, ws.Cells(j, 1))
            End If

        End If
    Next j

    'anything to hide?  Hide it.
    If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True

    ws.Range("Spendinginput").Select

    Application.ScreenUpdating = True
End Sub

Upvotes: 1

paxdiablo
paxdiablo

Reputation: 881353

The first thing I'd be looking at would be getting rid of the explicit loop for rows 10 through 149.

You could instead use the Range.Find method to locate the first cell containing H in the range you're interested in. As with all potential optimisations, you should check it but I would imagine Excel searching for a value under the covers might be faster than checking every single cell manually.

For example, consider this code:

Option Explicit
Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long

Sub Macro1()
    Dim ws As Worksheet
    Dim j As Integer
    Dim t As Long
    Dim x As Range

    If False Then ' or use true for explicit loop '
        t = GetTickCount
        j = 1
        Do While j <= 9999
            If Worksheets(1).Cells(j, 1).Value = "H" Then
                MsgBox ("found it " & j & " " & (GetTickCount - t))
                j = 10000
            End If
            j = j + 1
        Loop
    Else
        t = GetTickCount
        Set x = Range("A1:A9999").Find("H")
        MsgBox ("found it " & x.Row & " " & (GetTickCount - t))
    End If
End Sub

With true in the if statement (explicit loop) and a worksheet with nothing but a H in cell A9999, it takes about 46 milliseconds to find the value. Using the Range.Find() method drops that to zero.

Upvotes: 1

Related Questions