none
Code Optimization (For instruction) RRS feed

  • Question

  • Hi,

    I've a sheet within 30 000 rows and 30 columns

    I need to keep only the rows which have not the same value into two columns.

    Those values can appear anywhere along the rows. That the reason I've to scan all rows.

    So I wrote this simple code, but It takes a while to reach the solution.

    So, If you have a better way to optimize it, even to change all code, I'll appreciate.

    The code below:

    I'm starting from line 2 because of the labels inside the first line. Last means the number of the last Row counting.

    For j = 2 To Last- 1
      For k = j + 1 To Last
        If Range("A" & j).Value = Range("A" & k).Value And Range("U" & j).Value = Range("U" & k).Value Then
        Rows(k & ":" & k).Select
        Selection.Delete Shift:=xlUp
        k = k - 1
        Last = Last -1
    End If
      Next k
     Next j

    Tuesday, December 9, 2014 7:53 AM

All replies

  • You could use an autofilter to show only those rows which have the same values in the columns and then delete all the visible cells. I am sure that would be faster than iterating 30K rows. 

    Also consider, disabling events and screen updating as well as eliminating the .Select line.

    Rows(k & ":" & k).Delete Shift:=xlUp

    Tuesday, December 9, 2014 10:56 AM
  • Hello,

    you could try to use the find() method (and findnext)?

    http://msdn.microsoft.com/en-us/library/office/ff839746(v=office.15).aspx

    Tuesday, December 9, 2014 1:38 PM
  • Sub pMain()
      Dim lRow As Long
      Dim lLastRow As Long
      Dim lLastCol As Long
      Dim oSheet As Excel.Worksheet
      
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      
      Set oSheet = ActiveSheet
      With oSheet
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lRow = lLastRow To 2 Step -1
          lLastCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
          If pDuplicated(.Cells(lRow, "A").Resize(, lLastCol)) Then
            .Rows(lRow).Delete
          End If
        Next lRow
      End With
      
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End Sub
    
    Private Function pDuplicated(oRange As Excel.Range) As Boolean
      Const csFormula As String = "=MAX(COUNTIF(^^,^^))>1"
      Dim sAddress As String
      Dim sFormula As String
      
      sAddress = oRange.Address(0, 0)
      sFormula = Replace(csFormula, "^^", sAddress)
      
      If Evaluate(sFormula) = True Then pDuplicated = True
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    Monday, December 15, 2014 7:57 PM
  • Hi Felipe,

    What can I say ?

    Waouuuuuuh !!!

    How many years do I have to learn VBA to run beside you ?

    Thank you dear

    Sincerily

    Tuesday, December 16, 2014 6:32 PM
  • You're welcome. I've been studying VBA for 6 years.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    Tuesday, December 16, 2014 8:56 PM
  • Hi, Felipe,

    After some teste, it appears that all rows are deleted.

    I think it's because of the replace sAdress in sFormula. It's replace twice, so it's always true and then deleted...

    Sincerily

    Saturday, December 20, 2014 12:14 PM
  • "I think it's because of the replace sAdress in sFormula. It's replace twice, so it's always true and then deleted..."

    Yes, that's the idea. I want it to replace both times.

    ---

    Your original request:

    "I need to keep only the rows which have not the same value into two columns."

    For what I understood, it works properly. For example, use this setup:

    The code will delete only rows 4 and 10.

    Did I understand correctly?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    Saturday, December 20, 2014 1:18 PM
  • If I understand your requirements correctly, you could do this with a single line of code.  Although if this has to run on versions of Excel older than 2007, they may not have the RemoveDuplicates method.  If that is the case, post back and I will provide a much faster routine than what you have posted.

    Range("A1", "AD30000").RemoveDuplicates Columns:=Array(1, 21), Header:=xlYes

    Of course, you might want to add code to more accurately select the range to be processed, and perhaps some other stuff.

    If I did not understand your requirements, please clarify.  This code will leave a single instance of the duplicated item.


    Ron




    Saturday, December 20, 2014 7:23 PM