+ Reply to Thread
Results 1 to 9 of 9

need to make code more efficient (if possible)

  1. #1
    Lilivati
    Guest

    need to make code more efficient (if possible)

    (Yes, I'm back again with another question, this group saves my life on
    a daily basis... )

    Anyway, I've never been a terribly efficient programmer, especially
    with languages that are new to me (like VBA). Honestly I've never
    really had to be; for most of the things I write memory resources are
    more than adequate. However, most recently I've been working on a
    "clean-up" macro for a long excel file spat out from a database. The
    file is a massive parts list, and it has to be sorted and earlier
    revisions of a part (essentially duplicates for the purposes of this
    list) removed. The macro I wrote works well with shorter "test"
    versions of the real list, and there's no reason why it shouldn't work
    with the long list.

    The issue is that the real list has ~56k rows. It takes 30 minutes for
    just the first loop of the macro to execute. My machine is not the
    best (256 MB RAM) but it is typical of the machines that will
    ultimately use this macro. Running this macro also shoots my CPU usage
    to 100% from about 1-3% when it is not running. What is baffling to me
    is that this clean-up process is currently done by hand and it takes
    fractions of a second to execute a command over the entire list that
    way.

    The whole idea behind adding this macro is to make the clean-up process
    more efficient, and clearly that is not being accomplished if the macro
    takes hours to finish.

    The sub is called by pressing a button in another workbook (the
    "cleaner" workbook that holds all my macros).

    The first loop is necessary to sort the parts in correct numerical
    order, but it really takes a long time. Is there any way to clean it
    up? The sort and the second loop (which uses "i") are almost
    instantaneous, then on the third loop (which uses "j") I get a "System
    Error. The object invoked has disconnected from its clients." It is
    definitely the third loop because if I comment it out I don't get this
    error. As mentioned before this macro works in its entirety on a
    smaller list.

    The macro:

    Sub Nassort()

    Application.ScreenUpdating = False

    'variable transfer from a userform to a worksheet (or from any A to B
    in excel) is
    'sketchy so I use a short hidden name function to move things around
    instead
    Dim nwb As String
    nwb = GetHName("nassis")

    'stupid formatting workaround, to make data numeric
    With Workbooks(nwb).Worksheets(ws)
    .Cells(2, 11).Copy
    Dim k As Long
    For k = 2 To .UsedRange.Rows.Count
    .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    SkipBlanks:= _
    False, Transpose:=False
    Next k
    End With

    'sort the stuff by document and rev number
    With Workbooks(nwb).Worksheets(ws)
    .Range("A:F").sort _
    Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
    Order1:=xlAscending, _
    Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
    Order2:=xlAscending, _
    Header:=xlYes, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom
    End With


    'NOTE: If you don't do it this way (if you delete directly)
    'Excel will miss lower rev numbers when more than two revs
    'exist for a given part number

    'clear the row if it is a lower rev level
    Dim i As Long
    Dim j As Long
    With Workbooks(nwb).Worksheets(ws)

    For i = 2 To .UsedRange.Rows.Count
    If .Cells(i + 1, 3) = .Cells(i, 3) Then
    If .Cells(i, 1) = "" Then
    'do nothing, rev level is blank
    ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
    .Cells(i, 7) = "delete"
    '.UsedRange.Rows(i).EntireRow.Clear
    End If
    End If
    Next i

    'delete blank rows created above
    For j = UsedRange.Rows.Count To 2 Step -1
    If .Cells(j, 7) = "delete" Then
    '.Cells(j, 5) = "delete"
    .UsedRange.Rows(j).EntireRow.Delete
    End If
    Next j

    End With

    Application.ScreenUpdating = True

    End Sub


    Any ideas?


  2. #2
    Bernie Deitrick
    Guest

    Re: need to make code more efficient (if possible)

    Try not to loop when you don't need to:

    With Workbooks(nwb).Worksheets(ws)
    .Cells(2, 11).Copy
    Dim k As Long
    For k = 2 To .UsedRange.Rows.Count
    .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    SkipBlanks:= _
    False, Transpose:=False
    Next k
    End With

    Could be:

    With Workbooks(nwb).Worksheets(ws)
    .Cells(2, 11).Copy
    .Range(.Cells(2, 3), .Cells(.UsedRange.Rows.Count, 3)).PasteSpecial Paste:=xlAll, _
    Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
    End With


    And for the deletion, it is much faster to do it this way:

    Dim myRow As Long
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    With Workbooks(nwb).Worksheets(ws)
    myRow = .UsedRange.Rows.Count
    ..Range("G1").VAlue = "Keep/Delete"
    ..Range("G2").Formula = _
    "=IF(A3>A2,""Delete"","""")"
    ..Range("G2").AutoFill Destination:=.Range("G2:G" & myRow)
    ..Cells.Sort key1:=.Range("G2"), order1:=xlDescending, Header:=xlYes
    With .Range("G:G")
    .AutoFilter Field:=1, Criteria1:="Delete"
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .EntireColumn.Delete
    End With
    End With

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

    End Sub

    HTH,
    Bernie
    MS Excel MVP


    "Lilivati" <Lilivati@gmail.com> wrote in message
    news:1152277545.308397.188510@k73g2000cwa.googlegroups.com...
    > (Yes, I'm back again with another question, this group saves my life on
    > a daily basis... )
    >
    > Anyway, I've never been a terribly efficient programmer, especially
    > with languages that are new to me (like VBA). Honestly I've never
    > really had to be; for most of the things I write memory resources are
    > more than adequate. However, most recently I've been working on a
    > "clean-up" macro for a long excel file spat out from a database. The
    > file is a massive parts list, and it has to be sorted and earlier
    > revisions of a part (essentially duplicates for the purposes of this
    > list) removed. The macro I wrote works well with shorter "test"
    > versions of the real list, and there's no reason why it shouldn't work
    > with the long list.
    >
    > The issue is that the real list has ~56k rows. It takes 30 minutes for
    > just the first loop of the macro to execute. My machine is not the
    > best (256 MB RAM) but it is typical of the machines that will
    > ultimately use this macro. Running this macro also shoots my CPU usage
    > to 100% from about 1-3% when it is not running. What is baffling to me
    > is that this clean-up process is currently done by hand and it takes
    > fractions of a second to execute a command over the entire list that
    > way.
    >
    > The whole idea behind adding this macro is to make the clean-up process
    > more efficient, and clearly that is not being accomplished if the macro
    > takes hours to finish.
    >
    > The sub is called by pressing a button in another workbook (the
    > "cleaner" workbook that holds all my macros).
    >
    > The first loop is necessary to sort the parts in correct numerical
    > order, but it really takes a long time. Is there any way to clean it
    > up? The sort and the second loop (which uses "i") are almost
    > instantaneous, then on the third loop (which uses "j") I get a "System
    > Error. The object invoked has disconnected from its clients." It is
    > definitely the third loop because if I comment it out I don't get this
    > error. As mentioned before this macro works in its entirety on a
    > smaller list.
    >
    > The macro:
    >
    > Sub Nassort()
    >
    > Application.ScreenUpdating = False
    >
    > 'variable transfer from a userform to a worksheet (or from any A to B
    > in excel) is
    > 'sketchy so I use a short hidden name function to move things around
    > instead
    > Dim nwb As String
    > nwb = GetHName("nassis")
    >
    > 'stupid formatting workaround, to make data numeric
    > With Workbooks(nwb).Worksheets(ws)
    > .Cells(2, 11).Copy
    > Dim k As Long
    > For k = 2 To .UsedRange.Rows.Count
    > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > SkipBlanks:= _
    > False, Transpose:=False
    > Next k
    > End With
    >
    > 'sort the stuff by document and rev number
    > With Workbooks(nwb).Worksheets(ws)
    > .Range("A:F").sort _
    > Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
    > Order1:=xlAscending, _
    > Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
    > Order2:=xlAscending, _
    > Header:=xlYes, _
    > OrderCustom:=1, _
    > MatchCase:=False, _
    > Orientation:=xlTopToBottom
    > End With
    >
    >
    > 'NOTE: If you don't do it this way (if you delete directly)
    > 'Excel will miss lower rev numbers when more than two revs
    > 'exist for a given part number
    >
    > 'clear the row if it is a lower rev level
    > Dim i As Long
    > Dim j As Long
    > With Workbooks(nwb).Worksheets(ws)
    >
    > For i = 2 To .UsedRange.Rows.Count
    > If .Cells(i + 1, 3) = .Cells(i, 3) Then
    > If .Cells(i, 1) = "" Then
    > 'do nothing, rev level is blank
    > ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
    > .Cells(i, 7) = "delete"
    > '.UsedRange.Rows(i).EntireRow.Clear
    > End If
    > End If
    > Next i
    >
    > 'delete blank rows created above
    > For j = UsedRange.Rows.Count To 2 Step -1
    > If .Cells(j, 7) = "delete" Then
    > '.Cells(j, 5) = "delete"
    > .UsedRange.Rows(j).EntireRow.Delete
    > End If
    > Next j
    >
    > End With
    >
    > Application.ScreenUpdating = True
    >
    > End Sub
    >
    >
    > Any ideas?
    >




  3. #3
    Bill Schanks
    Guest

    Re: need to make code more efficient (if possible)

    I would also recommend, making calculation manual while this is running
    and turning it back on when done:

    At the beginning:
    Application.Calculation = xlCalculationManual

    At the end:
    Application.Calculation = xlCalculationAutomatic

    Also, I always try to put in error handling and a common exit point. I
    would put the command to put calculation back to automatic in the exit
    routine that way it is always turned back on when an error occurs.

    Bernie Deitrick wrote:
    > Try not to loop when you don't need to:
    >
    > With Workbooks(nwb).Worksheets(ws)
    > .Cells(2, 11).Copy
    > Dim k As Long
    > For k = 2 To .UsedRange.Rows.Count
    > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > SkipBlanks:= _
    > False, Transpose:=False
    > Next k
    > End With
    >
    > Could be:
    >
    > With Workbooks(nwb).Worksheets(ws)
    > .Cells(2, 11).Copy
    > .Range(.Cells(2, 3), .Cells(.UsedRange.Rows.Count, 3)).PasteSpecial Paste:=xlAll, _
    > Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
    > End With
    >
    >
    > And for the deletion, it is much faster to do it this way:
    >
    > Dim myRow As Long
    > With Application
    > .ScreenUpdating = False
    > .EnableEvents = False
    > End With
    >
    > With Workbooks(nwb).Worksheets(ws)
    > myRow = .UsedRange.Rows.Count
    > .Range("G1").VAlue = "Keep/Delete"
    > .Range("G2").Formula = _
    > "=IF(A3>A2,""Delete"","""")"
    > .Range("G2").AutoFill Destination:=.Range("G2:G" & myRow)
    > .Cells.Sort key1:=.Range("G2"), order1:=xlDescending, Header:=xlYes
    > With .Range("G:G")
    > .AutoFilter Field:=1, Criteria1:="Delete"
    > .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    > .EntireColumn.Delete
    > End With
    > End With
    >
    > With Application
    > .ScreenUpdating = True
    > .EnableEvents = True
    > End With
    >
    > End Sub
    >
    > HTH,
    > Bernie
    > MS Excel MVP
    >
    >
    > "Lilivati" <Lilivati@gmail.com> wrote in message
    > news:1152277545.308397.188510@k73g2000cwa.googlegroups.com...
    > > (Yes, I'm back again with another question, this group saves my life on
    > > a daily basis... )
    > >
    > > Anyway, I've never been a terribly efficient programmer, especially
    > > with languages that are new to me (like VBA). Honestly I've never
    > > really had to be; for most of the things I write memory resources are
    > > more than adequate. However, most recently I've been working on a
    > > "clean-up" macro for a long excel file spat out from a database. The
    > > file is a massive parts list, and it has to be sorted and earlier
    > > revisions of a part (essentially duplicates for the purposes of this
    > > list) removed. The macro I wrote works well with shorter "test"
    > > versions of the real list, and there's no reason why it shouldn't work
    > > with the long list.
    > >
    > > The issue is that the real list has ~56k rows. It takes 30 minutes for
    > > just the first loop of the macro to execute. My machine is not the
    > > best (256 MB RAM) but it is typical of the machines that will
    > > ultimately use this macro. Running this macro also shoots my CPU usage
    > > to 100% from about 1-3% when it is not running. What is baffling to me
    > > is that this clean-up process is currently done by hand and it takes
    > > fractions of a second to execute a command over the entire list that
    > > way.
    > >
    > > The whole idea behind adding this macro is to make the clean-up process
    > > more efficient, and clearly that is not being accomplished if the macro
    > > takes hours to finish.
    > >
    > > The sub is called by pressing a button in another workbook (the
    > > "cleaner" workbook that holds all my macros).
    > >
    > > The first loop is necessary to sort the parts in correct numerical
    > > order, but it really takes a long time. Is there any way to clean it
    > > up? The sort and the second loop (which uses "i") are almost
    > > instantaneous, then on the third loop (which uses "j") I get a "System
    > > Error. The object invoked has disconnected from its clients." It is
    > > definitely the third loop because if I comment it out I don't get this
    > > error. As mentioned before this macro works in its entirety on a
    > > smaller list.
    > >
    > > The macro:
    > >
    > > Sub Nassort()
    > >
    > > Application.ScreenUpdating = False
    > >
    > > 'variable transfer from a userform to a worksheet (or from any A to B
    > > in excel) is
    > > 'sketchy so I use a short hidden name function to move things around
    > > instead
    > > Dim nwb As String
    > > nwb = GetHName("nassis")
    > >
    > > 'stupid formatting workaround, to make data numeric
    > > With Workbooks(nwb).Worksheets(ws)
    > > .Cells(2, 11).Copy
    > > Dim k As Long
    > > For k = 2 To .UsedRange.Rows.Count
    > > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > > SkipBlanks:= _
    > > False, Transpose:=False
    > > Next k
    > > End With
    > >
    > > 'sort the stuff by document and rev number
    > > With Workbooks(nwb).Worksheets(ws)
    > > .Range("A:F").sort _
    > > Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
    > > Order1:=xlAscending, _
    > > Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
    > > Order2:=xlAscending, _
    > > Header:=xlYes, _
    > > OrderCustom:=1, _
    > > MatchCase:=False, _
    > > Orientation:=xlTopToBottom
    > > End With
    > >
    > >
    > > 'NOTE: If you don't do it this way (if you delete directly)
    > > 'Excel will miss lower rev numbers when more than two revs
    > > 'exist for a given part number
    > >
    > > 'clear the row if it is a lower rev level
    > > Dim i As Long
    > > Dim j As Long
    > > With Workbooks(nwb).Worksheets(ws)
    > >
    > > For i = 2 To .UsedRange.Rows.Count
    > > If .Cells(i + 1, 3) = .Cells(i, 3) Then
    > > If .Cells(i, 1) = "" Then
    > > 'do nothing, rev level is blank
    > > ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
    > > .Cells(i, 7) = "delete"
    > > '.UsedRange.Rows(i).EntireRow.Clear
    > > End If
    > > End If
    > > Next i
    > >
    > > 'delete blank rows created above
    > > For j = UsedRange.Rows.Count To 2 Step -1
    > > If .Cells(j, 7) = "delete" Then
    > > '.Cells(j, 5) = "delete"
    > > .UsedRange.Rows(j).EntireRow.Delete
    > > End If
    > > Next j
    > >
    > > End With
    > >
    > > Application.ScreenUpdating = True
    > >
    > > End Sub
    > >
    > >
    > > Any ideas?
    > >



  4. #4
    Bernie Deitrick
    Guest

    Re: need to make code more efficient (if possible)

    Bill,

    The code that I posted relies on calculations being on - otherwise the formulas don't properly
    reflect the sheet content.

    HTH,
    Bernie
    MS Excel MVP


    "Bill Schanks" <wschanks@gmail.com> wrote in message
    news:1152283473.387683.87410@75g2000cwc.googlegroups.com...
    >I would also recommend, making calculation manual while this is running
    > and turning it back on when done:
    >
    > At the beginning:
    > Application.Calculation = xlCalculationManual
    >
    > At the end:
    > Application.Calculation = xlCalculationAutomatic
    >
    > Also, I always try to put in error handling and a common exit point. I
    > would put the command to put calculation back to automatic in the exit
    > routine that way it is always turned back on when an error occurs.
    >
    > Bernie Deitrick wrote:
    >> Try not to loop when you don't need to:
    >>
    >> With Workbooks(nwb).Worksheets(ws)
    >> .Cells(2, 11).Copy
    >> Dim k As Long
    >> For k = 2 To .UsedRange.Rows.Count
    >> .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    >> SkipBlanks:= _
    >> False, Transpose:=False
    >> Next k
    >> End With
    >>
    >> Could be:
    >>
    >> With Workbooks(nwb).Worksheets(ws)
    >> .Cells(2, 11).Copy
    >> .Range(.Cells(2, 3), .Cells(.UsedRange.Rows.Count, 3)).PasteSpecial Paste:=xlAll, _
    >> Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
    >> End With
    >>
    >>
    >> And for the deletion, it is much faster to do it this way:
    >>
    >> Dim myRow As Long
    >> With Application
    >> .ScreenUpdating = False
    >> .EnableEvents = False
    >> End With
    >>
    >> With Workbooks(nwb).Worksheets(ws)
    >> myRow = .UsedRange.Rows.Count
    >> .Range("G1").VAlue = "Keep/Delete"
    >> .Range("G2").Formula = _
    >> "=IF(A3>A2,""Delete"","""")"
    >> .Range("G2").AutoFill Destination:=.Range("G2:G" & myRow)
    >> .Cells.Sort key1:=.Range("G2"), order1:=xlDescending, Header:=xlYes
    >> With .Range("G:G")
    >> .AutoFilter Field:=1, Criteria1:="Delete"
    >> .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    >> .EntireColumn.Delete
    >> End With
    >> End With
    >>
    >> With Application
    >> .ScreenUpdating = True
    >> .EnableEvents = True
    >> End With
    >>
    >> End Sub
    >>
    >> HTH,
    >> Bernie
    >> MS Excel MVP
    >>
    >>
    >> "Lilivati" <Lilivati@gmail.com> wrote in message
    >> news:1152277545.308397.188510@k73g2000cwa.googlegroups.com...
    >> > (Yes, I'm back again with another question, this group saves my life on
    >> > a daily basis... )
    >> >
    >> > Anyway, I've never been a terribly efficient programmer, especially
    >> > with languages that are new to me (like VBA). Honestly I've never
    >> > really had to be; for most of the things I write memory resources are
    >> > more than adequate. However, most recently I've been working on a
    >> > "clean-up" macro for a long excel file spat out from a database. The
    >> > file is a massive parts list, and it has to be sorted and earlier
    >> > revisions of a part (essentially duplicates for the purposes of this
    >> > list) removed. The macro I wrote works well with shorter "test"
    >> > versions of the real list, and there's no reason why it shouldn't work
    >> > with the long list.
    >> >
    >> > The issue is that the real list has ~56k rows. It takes 30 minutes for
    >> > just the first loop of the macro to execute. My machine is not the
    >> > best (256 MB RAM) but it is typical of the machines that will
    >> > ultimately use this macro. Running this macro also shoots my CPU usage
    >> > to 100% from about 1-3% when it is not running. What is baffling to me
    >> > is that this clean-up process is currently done by hand and it takes
    >> > fractions of a second to execute a command over the entire list that
    >> > way.
    >> >
    >> > The whole idea behind adding this macro is to make the clean-up process
    >> > more efficient, and clearly that is not being accomplished if the macro
    >> > takes hours to finish.
    >> >
    >> > The sub is called by pressing a button in another workbook (the
    >> > "cleaner" workbook that holds all my macros).
    >> >
    >> > The first loop is necessary to sort the parts in correct numerical
    >> > order, but it really takes a long time. Is there any way to clean it
    >> > up? The sort and the second loop (which uses "i") are almost
    >> > instantaneous, then on the third loop (which uses "j") I get a "System
    >> > Error. The object invoked has disconnected from its clients." It is
    >> > definitely the third loop because if I comment it out I don't get this
    >> > error. As mentioned before this macro works in its entirety on a
    >> > smaller list.
    >> >
    >> > The macro:
    >> >
    >> > Sub Nassort()
    >> >
    >> > Application.ScreenUpdating = False
    >> >
    >> > 'variable transfer from a userform to a worksheet (or from any A to B
    >> > in excel) is
    >> > 'sketchy so I use a short hidden name function to move things around
    >> > instead
    >> > Dim nwb As String
    >> > nwb = GetHName("nassis")
    >> >
    >> > 'stupid formatting workaround, to make data numeric
    >> > With Workbooks(nwb).Worksheets(ws)
    >> > .Cells(2, 11).Copy
    >> > Dim k As Long
    >> > For k = 2 To .UsedRange.Rows.Count
    >> > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    >> > SkipBlanks:= _
    >> > False, Transpose:=False
    >> > Next k
    >> > End With
    >> >
    >> > 'sort the stuff by document and rev number
    >> > With Workbooks(nwb).Worksheets(ws)
    >> > .Range("A:F").sort _
    >> > Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
    >> > Order1:=xlAscending, _
    >> > Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
    >> > Order2:=xlAscending, _
    >> > Header:=xlYes, _
    >> > OrderCustom:=1, _
    >> > MatchCase:=False, _
    >> > Orientation:=xlTopToBottom
    >> > End With
    >> >
    >> >
    >> > 'NOTE: If you don't do it this way (if you delete directly)
    >> > 'Excel will miss lower rev numbers when more than two revs
    >> > 'exist for a given part number
    >> >
    >> > 'clear the row if it is a lower rev level
    >> > Dim i As Long
    >> > Dim j As Long
    >> > With Workbooks(nwb).Worksheets(ws)
    >> >
    >> > For i = 2 To .UsedRange.Rows.Count
    >> > If .Cells(i + 1, 3) = .Cells(i, 3) Then
    >> > If .Cells(i, 1) = "" Then
    >> > 'do nothing, rev level is blank
    >> > ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
    >> > .Cells(i, 7) = "delete"
    >> > '.UsedRange.Rows(i).EntireRow.Clear
    >> > End If
    >> > End If
    >> > Next i
    >> >
    >> > 'delete blank rows created above
    >> > For j = UsedRange.Rows.Count To 2 Step -1
    >> > If .Cells(j, 7) = "delete" Then
    >> > '.Cells(j, 5) = "delete"
    >> > .UsedRange.Rows(j).EntireRow.Delete
    >> > End If
    >> > Next j
    >> >
    >> > End With
    >> >
    >> > Application.ScreenUpdating = True
    >> >
    >> > End Sub
    >> >
    >> >
    >> > Any ideas?
    >> >

    >




  5. #5
    Bill Schanks
    Guest

    Re: need to make code more efficient (if possible)

    My apolgies

    Bernie Deitrick wrote:
    > Bill,
    >
    > The code that I posted relies on calculations being on - otherwise the formulas don't properly
    > reflect the sheet content.
    >
    > HTH,
    > Bernie
    > MS Excel MVP
    >
    >
    > "Bill Schanks" <wschanks@gmail.com> wrote in message
    > news:1152283473.387683.87410@75g2000cwc.googlegroups.com...
    > >I would also recommend, making calculation manual while this is running
    > > and turning it back on when done:
    > >
    > > At the beginning:
    > > Application.Calculation = xlCalculationManual
    > >
    > > At the end:
    > > Application.Calculation = xlCalculationAutomatic
    > >
    > > Also, I always try to put in error handling and a common exit point. I
    > > would put the command to put calculation back to automatic in the exit
    > > routine that way it is always turned back on when an error occurs.
    > >
    > > Bernie Deitrick wrote:
    > >> Try not to loop when you don't need to:
    > >>
    > >> With Workbooks(nwb).Worksheets(ws)
    > >> .Cells(2, 11).Copy
    > >> Dim k As Long
    > >> For k = 2 To .UsedRange.Rows.Count
    > >> .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > >> SkipBlanks:= _
    > >> False, Transpose:=False
    > >> Next k
    > >> End With
    > >>
    > >> Could be:
    > >>
    > >> With Workbooks(nwb).Worksheets(ws)
    > >> .Cells(2, 11).Copy
    > >> .Range(.Cells(2, 3), .Cells(.UsedRange.Rows.Count, 3)).PasteSpecial Paste:=xlAll, _
    > >> Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
    > >> End With
    > >>
    > >>
    > >> And for the deletion, it is much faster to do it this way:
    > >>
    > >> Dim myRow As Long
    > >> With Application
    > >> .ScreenUpdating = False
    > >> .EnableEvents = False
    > >> End With
    > >>
    > >> With Workbooks(nwb).Worksheets(ws)
    > >> myRow = .UsedRange.Rows.Count
    > >> .Range("G1").VAlue = "Keep/Delete"
    > >> .Range("G2").Formula = _
    > >> "=IF(A3>A2,""Delete"","""")"
    > >> .Range("G2").AutoFill Destination:=.Range("G2:G" & myRow)
    > >> .Cells.Sort key1:=.Range("G2"), order1:=xlDescending, Header:=xlYes
    > >> With .Range("G:G")
    > >> .AutoFilter Field:=1, Criteria1:="Delete"
    > >> .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    > >> .EntireColumn.Delete
    > >> End With
    > >> End With
    > >>
    > >> With Application
    > >> .ScreenUpdating = True
    > >> .EnableEvents = True
    > >> End With
    > >>
    > >> End Sub
    > >>
    > >> HTH,
    > >> Bernie
    > >> MS Excel MVP
    > >>
    > >>
    > >> "Lilivati" <Lilivati@gmail.com> wrote in message
    > >> news:1152277545.308397.188510@k73g2000cwa.googlegroups.com...
    > >> > (Yes, I'm back again with another question, this group saves my life on
    > >> > a daily basis... )
    > >> >
    > >> > Anyway, I've never been a terribly efficient programmer, especially
    > >> > with languages that are new to me (like VBA). Honestly I've never
    > >> > really had to be; for most of the things I write memory resources are
    > >> > more than adequate. However, most recently I've been working on a
    > >> > "clean-up" macro for a long excel file spat out from a database. The
    > >> > file is a massive parts list, and it has to be sorted and earlier
    > >> > revisions of a part (essentially duplicates for the purposes of this
    > >> > list) removed. The macro I wrote works well with shorter "test"
    > >> > versions of the real list, and there's no reason why it shouldn't work
    > >> > with the long list.
    > >> >
    > >> > The issue is that the real list has ~56k rows. It takes 30 minutes for
    > >> > just the first loop of the macro to execute. My machine is not the
    > >> > best (256 MB RAM) but it is typical of the machines that will
    > >> > ultimately use this macro. Running this macro also shoots my CPU usage
    > >> > to 100% from about 1-3% when it is not running. What is baffling to me
    > >> > is that this clean-up process is currently done by hand and it takes
    > >> > fractions of a second to execute a command over the entire list that
    > >> > way.
    > >> >
    > >> > The whole idea behind adding this macro is to make the clean-up process
    > >> > more efficient, and clearly that is not being accomplished if the macro
    > >> > takes hours to finish.
    > >> >
    > >> > The sub is called by pressing a button in another workbook (the
    > >> > "cleaner" workbook that holds all my macros).
    > >> >
    > >> > The first loop is necessary to sort the parts in correct numerical
    > >> > order, but it really takes a long time. Is there any way to clean it
    > >> > up? The sort and the second loop (which uses "i") are almost
    > >> > instantaneous, then on the third loop (which uses "j") I get a "System
    > >> > Error. The object invoked has disconnected from its clients." It is
    > >> > definitely the third loop because if I comment it out I don't get this
    > >> > error. As mentioned before this macro works in its entirety on a
    > >> > smaller list.
    > >> >
    > >> > The macro:
    > >> >
    > >> > Sub Nassort()
    > >> >
    > >> > Application.ScreenUpdating = False
    > >> >
    > >> > 'variable transfer from a userform to a worksheet (or from any A to B
    > >> > in excel) is
    > >> > 'sketchy so I use a short hidden name function to move things around
    > >> > instead
    > >> > Dim nwb As String
    > >> > nwb = GetHName("nassis")
    > >> >
    > >> > 'stupid formatting workaround, to make data numeric
    > >> > With Workbooks(nwb).Worksheets(ws)
    > >> > .Cells(2, 11).Copy
    > >> > Dim k As Long
    > >> > For k = 2 To .UsedRange.Rows.Count
    > >> > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > >> > SkipBlanks:= _
    > >> > False, Transpose:=False
    > >> > Next k
    > >> > End With
    > >> >
    > >> > 'sort the stuff by document and rev number
    > >> > With Workbooks(nwb).Worksheets(ws)
    > >> > .Range("A:F").sort _
    > >> > Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
    > >> > Order1:=xlAscending, _
    > >> > Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
    > >> > Order2:=xlAscending, _
    > >> > Header:=xlYes, _
    > >> > OrderCustom:=1, _
    > >> > MatchCase:=False, _
    > >> > Orientation:=xlTopToBottom
    > >> > End With
    > >> >
    > >> >
    > >> > 'NOTE: If you don't do it this way (if you delete directly)
    > >> > 'Excel will miss lower rev numbers when more than two revs
    > >> > 'exist for a given part number
    > >> >
    > >> > 'clear the row if it is a lower rev level
    > >> > Dim i As Long
    > >> > Dim j As Long
    > >> > With Workbooks(nwb).Worksheets(ws)
    > >> >
    > >> > For i = 2 To .UsedRange.Rows.Count
    > >> > If .Cells(i + 1, 3) = .Cells(i, 3) Then
    > >> > If .Cells(i, 1) = "" Then
    > >> > 'do nothing, rev level is blank
    > >> > ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
    > >> > .Cells(i, 7) = "delete"
    > >> > '.UsedRange.Rows(i).EntireRow.Clear
    > >> > End If
    > >> > End If
    > >> > Next i
    > >> >
    > >> > 'delete blank rows created above
    > >> > For j = UsedRange.Rows.Count To 2 Step -1
    > >> > If .Cells(j, 7) = "delete" Then
    > >> > '.Cells(j, 5) = "delete"
    > >> > .UsedRange.Rows(j).EntireRow.Delete
    > >> > End If
    > >> > Next j
    > >> >
    > >> > End With
    > >> >
    > >> > Application.ScreenUpdating = True
    > >> >
    > >> > End Sub
    > >> >
    > >> >
    > >> > Any ideas?
    > >> >

    > >



  6. #6
    Bernie Deitrick
    Guest

    Re: need to make code more efficient (if possible)

    Bill,

    No apology needed - just wanted to make sure that the OP wasn't confused on the issue.

    Bernie
    MS Excel MVP

    > My apolgies




  7. #7
    Lilivati
    Guest

    Re: need to make code more efficient (if possible)

    Bernie-

    Thanks very much! After a few tweaks it is sorting out the data and
    deleting the appropriate rows beautifully. There is still one small
    problem however- when I try to delete the helper columns, for some
    reason the rows do not delete (I still have the whole list). Also, the
    "G" column does not really delete, but keeps its header and the entire
    column is filled with #REF indicating some kind of formula error.

    Here is the relevant portion of my modified macro:

    Dim myRow As Long
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    With Workbooks(nwb).Worksheets(ws)
    myRow = .UsedRange.Rows.Count
    .Range("G1").Value = "Counter"
    .Range("G2").Formula = "=IF(C2=C1,1+G1,0)"
    .Range("G2").AutoFill
    Destination:=Workbooks(nwb).Worksheets(ws).Range("G2:G" & myRow)

    .Range("H1").Value = "Keep/Delete"
    .Range("H2").Formula = "=IF(G3>G2,""Delete"",""Keep"")"
    .Range("H2").AutoFill
    Destination:=Workbooks(nwb).Worksheets(ws).Range("H2:H" & myRow)

    .Range(.Cells(2, 8), .Cells(.UsedRange.Rows.Count, 8)).Copy
    .Range(.Cells(2, 9), .Cells(.UsedRange.Rows.Count, 9)).PasteSpecial
    Paste:=xlValues, _
    SkipBlanks:=False, Transpose:=False

    .Cells.sort _
    key1:=Workbooks(nwb).Worksheets(ws).Range("I2"), _
    order1:=xlDescending, _
    Key2:=NONE, _
    Order2:=xlAscending, _
    Header:=xlYes
    With .Range("I:I")
    .AutoFilter Field:=1, Criteria1:="Keep"
    .Cells(xlCellTypeVisible).EntireRow.Delete
    End With

    .Range("G:G").EntireColumn.Delete
    .Range("H:H").EntireColumn.Delete
    .Range("I:I").EntireColumn.Delete

    End With

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


    Notes:

    I had to add an additional formula, or it was deleting parts that were
    not the same but had different rev levels. Also, I had to copy the
    values of the delete/keep column to a new column, or they would change
    when the cells were sorted as the formula updated itself.

    The original filter criteria you specified led to the deletion of the
    cells I wanted to keep, so I simply flipped it. Furthermore I am
    deleting more cells than the SpecialCells function can handle, so I
    changed this to simply Cells.

    On the entire columns deletions, I tried this inside the With Range as
    well as outside, and both tries result in the error described above.

    Thanks again!

    Bernie Deitrick wrote:
    > Try not to loop when you don't need to:
    >
    > With Workbooks(nwb).Worksheets(ws)
    > .Cells(2, 11).Copy
    > Dim k As Long
    > For k = 2 To .UsedRange.Rows.Count
    > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > SkipBlanks:= _
    > False, Transpose:=False
    > Next k
    > End With
    >
    > Could be:
    >
    > With Workbooks(nwb).Worksheets(ws)
    > .Cells(2, 11).Copy
    > .Range(.Cells(2, 3), .Cells(.UsedRange.Rows.Count, 3)).PasteSpecial Paste:=xlAll, _
    > Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
    > End With
    >
    >
    > And for the deletion, it is much faster to do it this way:
    >
    > Dim myRow As Long
    > With Application
    > .ScreenUpdating = False
    > .EnableEvents = False
    > End With
    >
    > With Workbooks(nwb).Worksheets(ws)
    > myRow = .UsedRange.Rows.Count
    > .Range("G1").VAlue = "Keep/Delete"
    > .Range("G2").Formula = _
    > "=IF(A3>A2,""Delete"","""")"
    > .Range("G2").AutoFill Destination:=.Range("G2:G" & myRow)
    > .Cells.Sort key1:=.Range("G2"), order1:=xlDescending, Header:=xlYes
    > With .Range("G:G")
    > .AutoFilter Field:=1, Criteria1:="Delete"
    > .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    > .EntireColumn.Delete
    > End With
    > End With
    >
    > With Application
    > .ScreenUpdating = True
    > .EnableEvents = True
    > End With
    >
    > End Sub
    >
    > HTH,
    > Bernie
    > MS Excel MVP
    >
    >
    > "Lilivati" <Lilivati@gmail.com> wrote in message
    > news:1152277545.308397.188510@k73g2000cwa.googlegroups.com...
    > > (Yes, I'm back again with another question, this group saves my life on
    > > a daily basis... )
    > >
    > > Anyway, I've never been a terribly efficient programmer, especially
    > > with languages that are new to me (like VBA). Honestly I've never
    > > really had to be; for most of the things I write memory resources are
    > > more than adequate. However, most recently I've been working on a
    > > "clean-up" macro for a long excel file spat out from a database. The
    > > file is a massive parts list, and it has to be sorted and earlier
    > > revisions of a part (essentially duplicates for the purposes of this
    > > list) removed. The macro I wrote works well with shorter "test"
    > > versions of the real list, and there's no reason why it shouldn't work
    > > with the long list.
    > >
    > > The issue is that the real list has ~56k rows. It takes 30 minutes for
    > > just the first loop of the macro to execute. My machine is not the
    > > best (256 MB RAM) but it is typical of the machines that will
    > > ultimately use this macro. Running this macro also shoots my CPU usage
    > > to 100% from about 1-3% when it is not running. What is baffling to me
    > > is that this clean-up process is currently done by hand and it takes
    > > fractions of a second to execute a command over the entire list that
    > > way.
    > >
    > > The whole idea behind adding this macro is to make the clean-up process
    > > more efficient, and clearly that is not being accomplished if the macro
    > > takes hours to finish.
    > >
    > > The sub is called by pressing a button in another workbook (the
    > > "cleaner" workbook that holds all my macros).
    > >
    > > The first loop is necessary to sort the parts in correct numerical
    > > order, but it really takes a long time. Is there any way to clean it
    > > up? The sort and the second loop (which uses "i") are almost
    > > instantaneous, then on the third loop (which uses "j") I get a "System
    > > Error. The object invoked has disconnected from its clients." It is
    > > definitely the third loop because if I comment it out I don't get this
    > > error. As mentioned before this macro works in its entirety on a
    > > smaller list.
    > >
    > > The macro:
    > >
    > > Sub Nassort()
    > >
    > > Application.ScreenUpdating = False
    > >
    > > 'variable transfer from a userform to a worksheet (or from any A to B
    > > in excel) is
    > > 'sketchy so I use a short hidden name function to move things around
    > > instead
    > > Dim nwb As String
    > > nwb = GetHName("nassis")
    > >
    > > 'stupid formatting workaround, to make data numeric
    > > With Workbooks(nwb).Worksheets(ws)
    > > .Cells(2, 11).Copy
    > > Dim k As Long
    > > For k = 2 To .UsedRange.Rows.Count
    > > .Cells(k, 3).PasteSpecial Paste:=xlAll, Operation:=xlAdd,
    > > SkipBlanks:= _
    > > False, Transpose:=False
    > > Next k
    > > End With
    > >
    > > 'sort the stuff by document and rev number
    > > With Workbooks(nwb).Worksheets(ws)
    > > .Range("A:F").sort _
    > > Key1:=Workbooks(nwb).Worksheets(ws).Range("C2"), _
    > > Order1:=xlAscending, _
    > > Key2:=Workbooks(nwb).Worksheets(ws).Range("A2"), _
    > > Order2:=xlAscending, _
    > > Header:=xlYes, _
    > > OrderCustom:=1, _
    > > MatchCase:=False, _
    > > Orientation:=xlTopToBottom
    > > End With
    > >
    > >
    > > 'NOTE: If you don't do it this way (if you delete directly)
    > > 'Excel will miss lower rev numbers when more than two revs
    > > 'exist for a given part number
    > >
    > > 'clear the row if it is a lower rev level
    > > Dim i As Long
    > > Dim j As Long
    > > With Workbooks(nwb).Worksheets(ws)
    > >
    > > For i = 2 To .UsedRange.Rows.Count
    > > If .Cells(i + 1, 3) = .Cells(i, 3) Then
    > > If .Cells(i, 1) = "" Then
    > > 'do nothing, rev level is blank
    > > ElseIf .Cells(i + 1, 1) > .Cells(i, 1) Then
    > > .Cells(i, 7) = "delete"
    > > '.UsedRange.Rows(i).EntireRow.Clear
    > > End If
    > > End If
    > > Next i
    > >
    > > 'delete blank rows created above
    > > For j = UsedRange.Rows.Count To 2 Step -1
    > > If .Cells(j, 7) = "delete" Then
    > > '.Cells(j, 5) = "delete"
    > > .UsedRange.Rows(j).EntireRow.Delete
    > > End If
    > > Next j
    > >
    > > End With
    > >
    > > Application.ScreenUpdating = True
    > >
    > > End Sub
    > >
    > >
    > > Any ideas?
    > >



  8. #8
    Bernie Deitrick
    Guest

    Re: need to make code more efficient (if possible)

    See my comments in-line...

    HTH,
    Bernie
    MS Excel MVP

    > Thanks very much! After a few tweaks it is sorting out the data and
    > deleting the appropriate rows beautifully. There is still one small
    > problem however- when I try to delete the helper columns, for some
    > reason the rows do not delete (I still have the whole list). Also, the
    > "G" column does not really delete, but keeps its header and the entire
    > column is filled with #REF indicating some kind of formula error.


    Sounds like you are deleting the wrong column - but try my suggestions and see what happens....

    > Here is the relevant portion of my modified macro:
    > With Workbooks(nwb).Worksheets(ws)
    > myRow = .UsedRange.Rows.Count
    > .Range("G1").Value = "Counter"
    > .Range("G2").Formula = "=IF(C2=C1,1+G1,0)"
    > .Range("G2").AutoFill
    > Destination:=Workbooks(nwb).Worksheets(ws).Range("G2:G" & myRow)
    >
    > .Range("H1").Value = "Keep/Delete"
    > .Range("H2").Formula = "=IF(G3>G2,""Delete"",""Keep"")"
    > .Range("H2").AutoFill
    > Destination:=Workbooks(nwb).Worksheets(ws).Range("H2:H" & myRow)
    >


    Try changing these two lines below:

    > .Range(.Cells(2, 8), .Cells(.UsedRange.Rows.Count, 8)).Copy
    > .Range(.Cells(2, 9), .Cells(.UsedRange.Rows.Count, 9)).PasteSpecial
    > Paste:=xlValues, _
    > SkipBlanks:=False, Transpose:=False


    to:

    .Range("G:H").Copy
    .Range("G:H").PasteSpecial Paste:=xlValues

    and sort on H rather than I:
    key1:=Workbooks(nwb).Worksheets(ws).Range("H2"), _

    > .Cells.sort _
    > key1:=Workbooks(nwb).Worksheets(ws).Range("I2"), _
    > order1:=xlDescending, _
    > Key2:=NONE, _
    > Order2:=xlAscending, _
    > Header:=xlYes


    And instead of filtering on H, try

    Dim myF As Range

    Set myF = Range("H:H").Find("Keep")
    Range(myF, myF.End(xlDown)).EntireRow.Delete


    Remove this.....
    > With .Range("I:I")
    > .AutoFilter Field:=1, Criteria1:="Keep"
    > .Cells(xlCellTypeVisible).EntireRow.Delete
    > End With


    and try this for the column deletion:

    .Range("G:H").Delete



  9. #9
    Lilivati
    Guest

    Re: need to make code more efficient (if possible)

    That worked brilliantly. Thanks a bunch!


    Bernie Deitrick wrote:
    > See my comments in-line...
    >
    > HTH,
    > Bernie
    > MS Excel MVP
    >
    > > Thanks very much! After a few tweaks it is sorting out the data and
    > > deleting the appropriate rows beautifully. There is still one small
    > > problem however- when I try to delete the helper columns, for some
    > > reason the rows do not delete (I still have the whole list). Also, the
    > > "G" column does not really delete, but keeps its header and the entire
    > > column is filled with #REF indicating some kind of formula error.

    >
    > Sounds like you are deleting the wrong column - but try my suggestions and see what happens....
    >
    > > Here is the relevant portion of my modified macro:
    > > With Workbooks(nwb).Worksheets(ws)
    > > myRow = .UsedRange.Rows.Count
    > > .Range("G1").Value = "Counter"
    > > .Range("G2").Formula = "=IF(C2=C1,1+G1,0)"
    > > .Range("G2").AutoFill
    > > Destination:=Workbooks(nwb).Worksheets(ws).Range("G2:G" & myRow)
    > >
    > > .Range("H1").Value = "Keep/Delete"
    > > .Range("H2").Formula = "=IF(G3>G2,""Delete"",""Keep"")"
    > > .Range("H2").AutoFill
    > > Destination:=Workbooks(nwb).Worksheets(ws).Range("H2:H" & myRow)
    > >

    >
    > Try changing these two lines below:
    >
    > > .Range(.Cells(2, 8), .Cells(.UsedRange.Rows.Count, 8)).Copy
    > > .Range(.Cells(2, 9), .Cells(.UsedRange.Rows.Count, 9)).PasteSpecial
    > > Paste:=xlValues, _
    > > SkipBlanks:=False, Transpose:=False

    >
    > to:
    >
    > .Range("G:H").Copy
    > .Range("G:H").PasteSpecial Paste:=xlValues
    >
    > and sort on H rather than I:
    > key1:=Workbooks(nwb).Worksheets(ws).Range("H2"), _
    >
    > > .Cells.sort _
    > > key1:=Workbooks(nwb).Worksheets(ws).Range("I2"), _
    > > order1:=xlDescending, _
    > > Key2:=NONE, _
    > > Order2:=xlAscending, _
    > > Header:=xlYes

    >
    > And instead of filtering on H, try
    >
    > Dim myF As Range
    >
    > Set myF = Range("H:H").Find("Keep")
    > Range(myF, myF.End(xlDown)).EntireRow.Delete
    >
    >
    > Remove this.....
    > > With .Range("I:I")
    > > .AutoFilter Field:=1, Criteria1:="Keep"
    > > .Cells(xlCellTypeVisible).EntireRow.Delete
    > > End With

    >
    > and try this for the column deletion:
    >
    > .Range("G:H").Delete



+ 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