I'm Not Sure What I'm Trying To Do Is Called

[Drakey]

Say I have 20 Cells. Each cell contains a word, or multiple words. I need to remove one cell from all of the other cells and do this for every cell. Example...

Red
Blue
Green
yellow
Blue Orange
Green Banana
Cat
Dog
Blue Cat
Blue Dog
Blue Turtle
etc...

The cell the word Red would then be removed leaving all the other cells as above.

Blue
Green
yellow
Blue Orange
Green Banana
Cat
Dog
Blue Cat
Blue Dog
Blue Turtle
etc...

Then the cell with the word red would then come back in and the cell with the word blue would then be removed leaving all the other cells, plus the cell with the word red added back in as seen below...

Red
Green
yellow
Blue Orange
Green Banana
Cat
Dog
Blue Cat
Blue Dog
Blue Turtle
etc...

And so on... (The 3rd cell with the word Green has now been removed and the cell that was removed previously is now back)

Red
Blue
yellow
Blue Orange
Green Banana
Cat
Dog
Blue Cat
Blue Dog
Blue Turtle
etc...

I need this done for every cell, but in a way where I can simply copy and paste all the words I need into a formula and it does this automatically.

Any help would be appreciated.

Thanks
tyson

 

[MickG]

Try this:-
The code holds Column "A" Data in Column "Z" and updates Column "A" each time column "A" is clicked.

Private [COLOR=navy]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR=navy]As[/COLOR] Range)
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range, p [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] rng [COLOR=navy]As[/COLOR] Range
Static c
[COLOR=navy]If[/COLOR] Not Intersect(Columns("A:A"), Target) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
    [COLOR=navy]If[/COLOR] Range("Z1") = "" [COLOR=navy]Then[/COLOR]
        Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Copy Range("Z1")
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Set[/COLOR] rng = Range(Range("Z1"), Range("Z" & Rows.Count).End(xlUp))
ReDim ray(1 To rng.Count)
   c = c + 1
    c = IIf(c = rng.Count, 0, c)
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] rng
            [COLOR=navy]If[/COLOR] Not Dn.Row = c [COLOR=navy]Then[/COLOR]
                 p = p + 1
                 ray(p) = Dn
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] Dn
Columns("A:A").ClearContents
Range("A1").Resize(rng.Count) = Application.Transpose(ray)
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Drakey]

Hi Mick,

Thanks for your help. Seems to work just fine.