CODEWITHSUNDEEP
excelvbafor-looprange
maxim465
maxim465

Reputation: 195

Clear the contents of cells

There is a program that cleans the contents of certain ranges of cells. It works fine, but slowly (7 min) . How to accelerate this program?

Sub óäàëèòü()
    Dim book1 As Workbook
    Dim B As String
    Dim v As Long
    Dim e As Long

    B = "14"

    Set book1 = Workbooks.Open("E:\Super M\Ïðîåêò ñòàâêè\Ïîèñê ðåøåíèÿ\Óñîâ 7\Óñëîâèÿ äëÿ àíäåðäîãîâ\" + B + ".xlsm")

    For v = 1 To 14
        For e = 0 To 8
            book1.Worksheets("Ëèñò" & v).Cells(34, 26 + (e * 21)).Resize(128, 5).ClearContents
        Next e
    Next v

    book1.Save
    book1.Close

End Sub

Upvotes: 1

Views: 109

Answers (3)

DiegoB
DiegoB

Reputation: 1

`Sub` óäàëèòü()
    Dim book1 As Workbook
    Dim B As String
    Dim v As Long
    Dim e As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    If Workbooks.Count Then
      ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False
    End If
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    B = "14"

      Set book1 = Workbooks.Open("E:\Super M\Ïðîåêò ñòàâêè\Ïîèñê ðåøåíèÿ\Óñîâ                                
      7\Óñëîâèÿ äëÿ àíäåðäîãîâ\" + B + ".xlsm")
      For v = 1 To 14
        For e = 0 To 8
            book1.Worksheets("Ëèñò" & v).Cells(34, 26 + (e * 21)).Resize(128,5).
    ClearContents        
        Next e
    Next v

    book1.Save
    book1.Close

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

     If Workbooks.Count Then
      ActiveWorkbook.ActiveSheet.DisplayPageBreaks = True

    End If
     Application.DisplayStatusBar = True
     Application.DisplayAlerts = True
     End Sub

i added few tips that i and also, link to very usefull article (for me)
Optimising Lookups in google will be first link

Upvotes: 0

Variatus
Variatus

Reputation: 14383

I see you already accepted an answer. However, I should be interested in knowing if the idea encoded below is comparable. The code selects all 14 sheets and deletes the ranges in all of them in a single operation in place of 126.

Sub Something()
    ' 29 Jan 2018

    Dim Book1 As Workbook
    Dim WsNames(1 To 14) As Variant
    Dim WsArr As Variant
    Dim Rng As Range
    Dim B As String
    Dim v As Long
    Dim e As Long

    B = "14"
    Set Book1 = Workbooks.Open("E:\Super M\?e??¨º¨° ?¨°¨¤a¨º¨¨\??¨¨?¨º e???¨ª¨¨?\¨®??a 7\¨®???a¨¨? ??? ¨¤¨ª??e????a\" + B + ".xlsm")

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    For v = 1 To 14                     ' match loops to declaration
        WsNames(v) = "Sheet" & v
    Next v
    For e = 0 To 8
        B = Cells(34, 26 + (e * 21)).Resize(128, 5).Address
        With Book1.Worksheets(WsNames(1))
            If Rng Is Nothing Then
                Set Rng = .Range(B)
            Else
                Set Rng = Application.Union(Rng, .Range(B))
            End If
        End With
    Next e

    Set WsArr = Worksheets(WsNames)
    WsArr.Select
    Rng.Select
    Selection.ClearContents

    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

    With Book1
        .Worksheets(WsNames(1)).Activate
        .Save
        .Close
    End With
End Sub

Upvotes: 1

Miguel_Ryu
Miguel_Ryu

Reputation: 1418

One way to improve performance is to disable Excel calculations and screen updating as below, that way the application does less calculations.

Sub óäàëèòü()
    Dim book1 As Workbook
    Dim B As String
    Dim v As Long
    Dim e As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    B = "14"

    Set book1 = Workbooks.Open("E:\Super M\Ïðîåêò ñòàâêè\Ïîèñê ðåøåíèÿ\Óñîâ 7\Óñëîâèÿ äëÿ àíäåðäîãîâ\" + B + ".xlsm")

    For v = 1 To 14
        For e = 0 To 8
            book1.Worksheets("Ëèñò" & v).Cells(34, 26 + (e * 21)).Resize(128, 5).ClearContents
        Next e
    Next v

    book1.Save
    book1.Close

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

Upvotes: 3

Related Questions