delete cells but not rows

Question

I have an excel sheet where I am pulling data from other worksheets into separate columns per worksheet I pull from. I am trying to find any duplicates in any of my columns and delete all the duplicates (for example: if there are three of the code 12gb, I want to be left with one 12gb). I want this so that I can count how many unique values there are (automatically) and then populate a graph automatically. I have tried many different formulas to do this but I am thinking a VBA code is needed, however I have never used that coding before so I am not sure what to do.Below is an example of three columns of my excel sheet:(I wasn't able to post images/excel sheets)

12gb        sdf     vfg
22rg        tttyhg  dsf
dfg455      ggff    df
fgfg        fff     vcs
4redd       ccv     dfgh
56ff        66hg    66y
yygf        66y     56ff
66ygt       yggfg   12gb
ghhg        
            vfg     

Answer 1

This is a hackish macro it relies on specific columns and placements so I'm not a big fan of this solution.

It was generated by recording the manual tasks I did

• adding a row to denote end of columns
• copying the columns 2 and 3 to the end of column 1.
• removing the duplicates in column a
• then manually creating the 3 columns again. based on the end of column notes added.

.

Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("A12").Select
ActiveCell.FormulaR1C1 = "1----"
Range("B12").Select
ActiveCell.FormulaR1C1 = "2----"
Range("C12").Select
ActiveCell.FormulaR1C1 = "3----"
Range("B1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A13").Select
ActiveSheet.Paste
Range("B13").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Range("A13").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A25").Select
ActiveSheet.Paste
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$46").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A13:A22").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Range("A23").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("B13").Select

Now this assumes Row data isn't relevant. If it is... this will not work. as Excel deletes the duplicates.

Answer 2

you could do something like this, although i'm sure there are more elegant ways. in principle i just put each value into an array after checking if the value is not already in the array:

Sub del_values()
Dim last_row, last_col, size, y As Integer
Dim arr() As Variant

'finding the last row and last column and calculating the possible size of the array

last_row = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
last_col = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
size = last_row * last_col
y = 0

'adjusting the array-size    
ReDim arr(size)

For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(last_row, last_col))

'avoiding blank cells
If cell.Value > "" Then

'checking if value is already in the array - if not, add it to the array and increase y - if it is, clear the contents of the cell
If IsError(Application.Match(cell.Value, arr, 0)) Then
arr(y) = cell.Value
y = y + 1
Else
Cells(cell.Row, cell.Column).ClearContents
End If
End If
Next
End Sub

i was not sure what you wanted to do with the cells containing duplicates, so i just cleared the contents - you could of course just delete them with

Cells(cell.Row, cell.Column).delete

by the way, y is equal to the number of unique values, if you want to use it directly.