VBA/Macro to use the last column of a worksheet to pull only text and remove duplicates

[k_one]

Hi,

I am wanting to create a macro (which I am hideously new to, sorry), to take the last column from a worksheet (it is a growing worksheet that gets added to daily) and take only the cells which contain text (there are a mixture of text, blanks and numbers) and remove the duplicates.

The table is headed up with dates, the amount of rows used will also vary on a daily basis.

I tired to record a macro but failed. Any help anyone could give me would be appreciated.

I've attached an example of the data I'm using. </SPAN>

[TABLE="class: grid, width: 149"]
<TBODY>[TR]
[TD="align: right"]27/06/2013
[/TD]
[TD="align: right"]28/06/2013
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]APPLE
[/TD]
[TD]APPLE
[/TD]
[/TR]
[TR]
[TD="align: right"]1001
[/TD]
[TD="align: right"]1001
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ORANGE
[/TD]
[TD]ORANGE
[/TD]
[/TR]
[TR]
[TD="align: right"]2003
[/TD]
[TD="align: right"]2003
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PEAR
[/TD]
[TD]FEIJOA
[/TD]
[/TR]
[TR]
[TD="align: right"]5896
[/TD]
[TD="align: right"]3451
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PINEAPPLE
[/TD]
[TD]APPLE
[/TD]
[/TR]
[TR]
[TD="align: right"]8524
[/TD]
[TD="align: right"]1001
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]APPLE
[/TD]
[TD]APPLE
[/TD]
[/TR]
[TR]
[TD="align: right"]1001
[/TD]
[TD="align: right"]1001
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PEAR
[/TD]
[TD]PEAR
[/TD]
[/TR]
[TR]
[TD="align: right"]5896
[/TD]
[TD="align: right"]5896
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]BANANA
[/TD]
[TD]BANANA
[/TD]
[/TR]
[TR]
[TD="align: right"]5478
[/TD]
[TD="align: right"]5478
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]FEIJOA
[/TD]
[TD]FEIJOA
[/TD]
[/TR]
[TR]
[TD="align: right"]3451
[/TD]
[TD="align: right"]3451
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]BANANA
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]5478
[/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]

 

[tlowry]

Welcome to MrExcel!

So here's what I read:

Blank and numeric cells don't get changed

Duplicate text cells get changed to blanks. (except one)

Try this and let us know what changes need to be made


Install instructions

• Open a test file with columns of data (like the example)
• Go into development mode (alt F11)
• Open a new Module (Insert | Module)
• Copy and paste this code into the module
• Exit development mode (alt F11)
• Make sure the data is showing (Active Sheet)
• Save the workbook (Ctrl S)
• Run macro MakeCorrections (Alt F8)

• Test a lot

Sub MakeCorrections()
    Dim lc, cCell
    lc = Cells(1, Columns.Count - 1).End(xlToLeft).Column
    For Each cCell In Columns(lc).Cells
        If Not IsNumeric(cCell) And _
             Application.WorksheetFunction.CountIf(Columns(lc), _
            cCell) > 1 Then Cells(cCell.Row, lc) = ""
    Next
End Sub

 

[k_one]

Thank you for your reply and your help tlowry!

That works a treat.

Is there a way that the data could be kept as it is, and the macro paste just the text fields (minus the duplicates) into a new page? Also, could the data in the new sheet just be overwritten on a daily basis when the macro needs to be run again?

 

[tlowry]

Is this what you are needing?

Sub MakeNewSheet()
    Dim lc, cCell
    lc = Cells(1, Columns.Count - 1).End(xlToLeft).Column
    Dim dict
    Set dict = CreateObject("Scripting.Dictionary")
    dict.removeall
    Sheets("Sheet2").Cells.ClearContents
    For Each cCell In Sheets("Sheet1").Columns(lc).Cells
        If Not IsNumeric(cCell) And Len(Trim(cCell)) > 0 Then
            If Not dict.exists(cCell.Value) Then
                dict.Add cCell.Value, ""
                Sheets("sheet2").Cells(dict.Count, 1) = cCell.Value
            End If
        End If
    Next
End Sub

 

[k_one]

Ace! Exactly what I was after.

Thank you so so much tlowry!