8
\$\begingroup\$

This is the original code I had for removing duplicates from a sheet:

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

    ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(5, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes

Range("C" & Rows.Count).End(xlUp).Offset(1).Select

Application.ScreenUpdating = True

Call Hide_Columns_Swivel

End Sub

I added a section to this code (see below) that clears contents of fake empty cells. But now the code takes up to 15 seconds to run. It works as it is suppose to, just really slowly.

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

Dim usedrng As Range

    ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(5, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes

    For Each usedrng In ActiveSheet.UsedRange
        If usedrng.Value = "" Then
            usedrng.ClearContents
        End If
    Next

Range("C" & Rows.Count).End(xlUp).Offset(1).Select

Application.ScreenUpdating = True

Call Hide_Columns_Swivel

End Sub

I need help making this more efficient as I do not know enough about VBA to do that. All assistance is greatly appreciated.

Improve this question
\$\endgroup\$
  • 1
    \$\begingroup\$ Is there a purpose to clearing the contents of empty cells? \$\endgroup\$ – Comintern Jan 9 '16 at 0:39
  • \$\begingroup\$ @Comintern Yes. I run a conditional format code from the worksheet object that checks AD2:AD2000. If we insert a date into this column for a row, it changes the text in the row to green. The problem was that the remove duplicates code was adding null values to the cells. I would test this by pasting the data in and adding a date to AD for any of the rows with new data. The change would occur. But, once we ran the remove duplicates, all the rows would change to green text. So I added this code to clear out the fake empties. \$\endgroup\$ – Iron Man Jan 11 '16 at 0:50
12
\$\begingroup\$

If you are trying to get zero-length strings left after reverting formulas (that may have resulted in "" ) to their values, the quickest way is to spin through the columns and apply a quick Text-to-Columns, Fixed Width, Finish to each.

Dim c As Long
With worksheets("Sheet1")
    With .Range("A1").CurrentRegion  `<~~ set to the desired range of one or more columns
        For c = 1 To .Columns.Count
            .Columns(c).TextToColumns Destination:=.Columns(c), _
                DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
        Next c
    End With
End With

This process will take zero-length strings and make then truly blank cells. This is an important step in preppinga worksheet for direct non-CSV import to MS-SQL.

Improve this answer
\$\endgroup\$
  • \$\begingroup\$ How does this work? Loop through the columns and go .TextToColumns on each with the destination as the original column you just performed this on (overwrite). Would this retain cells in the column that have a non-blank value? Maybe I'm thrown off by the FieldInfo argument, but I can't seem to deconstruct this in my head. \$\endgroup\$ – Raystafarian Jan 11 '16 at 17:36
  • \$\begingroup\$ While a zero-length string is retained when reverting formulas to their results (e.g. .cells = .value ), looping through a TextToColumns reevaluates the values, discarding zero-length strings. You can do the same thing with dim arr as variant: arr = cells.value: cells = arr but that can be expensive in large blocks of data; better to take it one column at a time. The FieldInfo parameter is required but simply used as General (see xlColumnDataType ). Cells with values will not have their values changed. \$\endgroup\$ – user66882 Jan 11 '16 at 17:47
  • \$\begingroup\$ Ah, clever! Thanks! Would it end up repopulating with empty strings once excel recalculates the formulas? \$\endgroup\$ – Raystafarian Jan 11 '16 at 17:49
  • 1
    \$\begingroup\$ Well, it isn't going to do anything unless the formulas were removed in the first place. That was implied in my first sentence. You have to revert formulas to their result value (which may leave zero-length strings) before you can remove the zero-length strings. \$\endgroup\$ – user66882 Jan 11 '16 at 18:11
2
\$\begingroup\$

Using Replace will convert non-blank, zero-length-string cells to truly blank cells.

With ActiveSheet.Range("A1").UsedArea
  'First convert zero-length cells to a unique value
  .Replace("", "MontgomeryBurns")
  'Then convert all of those cells to Empty cells
  .Replace("MontgomeryBurns", "")
End With
Improve this answer
\$\endgroup\$
  • 2
    \$\begingroup\$ Why not set them to vbnullstring instead of "" again? \$\endgroup\$ – Raystafarian Jan 11 '16 at 17:37
1
\$\begingroup\$

So I have played around with the code by using suggestions posted here, and also from other sources. I have made the following changes to the Remove_Duplicates sub:

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

    ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(5, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes

Range("C" & Rows.Count).End(xlUp).Offset(1).Select

Call CTEGT

Application.ScreenUpdating = True

Call Hide_Columns_Swivel

End Sub

I added Call CTEGT which is the following code:

Sub CTEGT()

Dim LastRow As Long
Dim i As Long
LastRow = 1000 'change this to the last row
Application.EnableEvents = True

    For i = 2 To LastRow
        If Trim(Range("AD" & i).Value) = "" Then Range("AD" & i).ClearContents
    Next

End Sub

Over the last few days of new data being added, it was taking exponentially longer to run the code. This new iteration is now almost instant.

Thanks for all the contributions. I hope this assists anyone with a similar issue in the future.

Improve this answer
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.