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>

27/06/2013	28/06/2013
APPLE	APPLE
1001	1001
ORANGE	ORANGE
2003	2003
PEAR	FEIJOA
5896	3451
PINEAPPLE	APPLE
8524	1001
APPLE	APPLE
1001	1001
PEAR	PEAR
5896	5896
BANANA	BANANA
5478	5478
FEIJOA	FEIJOA
3451	3451
BANANA
5478

<TBODY>
</TBODY>

 

[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!