Re-arrange a columns data without sorting.

[paulked]

Hi

I have 500 single letters in column A. I would like to find the first 20 unique letters and move those to the top of the list (starting at A2).

Example:



Before
After


F
F


G
G


P
P


W
W


P
H


H
I


G
...


I



...




















Any ideas?

Best regards

Paul Ked

[excelliot]

Hi,

Put this formula in cell B2
=COUNTIF($A$2:A2,A2) & drag below..Then select both column & sort on column B ascending..

Cheers!!

[snb]

Sub M_snb()
Columns(1).AdvancedFilter 2, , Cells(1, 4), -1
End Sub

[paulked]

Thanks for replies.

Excelliot, I need to do this programatically :type

Snb, that's really neat :clever:, but my example of what I am trying to achieve wasn't very clear :o: .

How do i put the 1st 20 of the created list back into the top of column A without adding any more letters to the list?

eg If it were to be the first 5 instead of 20:

Column A
F
G
P
W
P
H
G
I
J
K
... to row 500

Would become:

Column A
F
G
P
W
H
P
G
I
J
K
... to row 500

Just to explain a bit further: The letters represent the first letter to an answer of a question. There are 20 questions in each round and each round can only have one occurance of the letter (Blockbusters quiz).

I've got to go to work now, but I'll check back later.

Many thanks

Paul Ked

[SamT]

Paul,

Can you take a few steps backwards so you can see more of the forest? You've been concentrating on this particular issue so much that you aren't giving us enough information to help you.

Tell us more about the project.

[paulked]

Ok.

On the first sheet there is a quiz game interface. This consists of a 5x4 grid and each cell of the grid contains a letter.

Team A are trying to get from left to right and team B are trying to get from top to bottom of the grid. To do this they must answer a question which 'wins' them the cell on the grid.

The questions posed to the two teams are in the format "What 'V' is the best forum for VBA Help?" and are stored on the second sheet. Column A holds the 1st letter of the answer (in this case 'V') and is the letter that is placed in the cell of the game grid to begin with.

There are 500 questions on sheet 2 and each time a question is asked the letter is removed from column A and placed in column B (to prevent that question from being asked again).

Once a team has won a round (ie made it from one side of the grid to the other) the grid is cleared and another 20 letters (from sheet 2, column A) are inserted into the grid.

As the contestants select the cell with "Can I have a 'V' please?" or similar, I can't duplicate any letters in the grid.

If the column starts off with A B C ... X Y Z then the first round is easy, just insert the top 20 letters.

After the first round lets say A D C G H I L M N Q R S were used.

This leaves D E F J K O P T U V W X Y Z A B C D E F G H I J ...etc.

The next fill of the grid takes the first 20 letters and there is the problem, two of each D E & F.

Therefore, I would like to use the first 20 unique letters to fill the grid.

Option 2

I could use the questions in batches of 20, but this would mean questions being 'wasted' as, for example, Team B could answer the first four of questions in a row and win the round, thus wasting 16 questions.

These could go back into the list but then they would still have to be checked for duplicates before going back into the grid as thier order would be random.

Note: The questions are not in alphabetical order, that would be way too boring and could give an unfair advantage to a team.

Hope this helps.

Cheers

Paul Ked

[paulked]

13791

[paulked]

I've sorted it thanks...



Sub FilterQuestions()
Dim i As Integer, j As Integer, LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
Columns(4).ClearContents
Columns(1).AdvancedFilter 2, , Cells(1, 4), -1
Range("D1:D21").Copy
Range("C1").PasteSpecial
For i = 2 To 21
For j = 2 To LR
If Range("C" & i).Value = Range("A" & j).Value Then
Range("A" & j).Delete Shift:=xlUp
Exit For
End If
Next
Next
Columns(4).ClearContents
Range("C1").ClearContents
Range("C2:C21").Cut
Range("A2").Insert Shift:=xlDown
End Sub


Maybe not the prettiest bit of code, but it works.

Many thanks to Snb for that great tip.

Regards

Paul Ked