How to Compare Column 12 to values in column 6 while deleting dups from column 12

**Launchnet** · 12-12-2011, 01:08 AM

The preview function is not working tonight, so I hope this is OK.

Sorry, I have no idea on how to code this, so I will try give a good description of what I need.

I have a list of new names in column 12.

Column 6 has permenant list of names.

I need to compare the new names in column 12 against names in column 6.

All names in column 12 that are found in column 6 should be deleted from column 12.

Basically a simple application, but I don't know how to do a comparison.

Thanks for the help.

**rylo** · 12-12-2011, 01:19 AM

Hi

how about

Sub aaa()
  For Each ce In Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("F:F"), ce) > 0 Then ce.Delete shift:=xlUp
  Next ce
End Sub

rylo

**Launchnet** · 12-12-2011, 01:26 AM

Good Evening from Here . . .

Looks good, but I have one question. sometimes there are blanks in column 12 before getting to the end of the data. My question is "Will this work with blanks"? If so, then how does the macro know when to stop at the end of the data?

Otherwise it looks good so far.

**Launchnet** · 12-12-2011, 01:27 AM

I for got to mention that neither list is in alpha-numeric order.

**rylo** · 12-12-2011, 01:34 AM

Hi

It will ignore blanks, and it determines the last cell to action by going from the last row in the worksheet up.

What do you want to do with blank cells?

rylo

**Launchnet** · 12-12-2011, 01:40 AM

Thanks

It would be nice if the blanks in column 12, between the 1st and last values were to be removed so that 12 has a continious list of values would be great.

Can't think of anything else right now. It's getting too late to think.

Thanks Rylo

**rylo** · 12-12-2011, 06:02 PM

Hi

Didn't test this but I think it should do it.

Sub aaa()
  For Each ce In Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("F:F"), ce) > 0 Or Len(ce) = 0 Then ce.Delete shift:=xlUp
  Next ce
End Sub

rylo

**JohnM3** · 12-13-2011, 03:52 AM

Hi rylo

Perhaps I am running it wrong ... but if I put

A
B
C
D
E
F

In column F

and

A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
W
X
Y
Z

in column L

After running

Sub aaa()
Dim ce As Excel.Range
For Each ce In Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row)
If WorksheetFunction.CountIf(Range("F:F"), ce) > 0 Then ce.Delete shift:=xlUp
Next ce
End Sub

Column L contains ......

B
D
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
W
X
Y
Z

Was this the desired result?

regards
John

**Launchnet** · 12-13-2011, 08:39 AM

Good Morning Rylo . . .

My results are the same as JohnM3 and there should be a change

When completed, column F should contain all the entries from column L

The values in column L that are already found in column F should be deleted.

The values in column L that do not have a duplicate in column F should be added at the end of column F and deleted from column L.

When finished, column L should be blank and there should be no duplicates in column F

Hope I cleared this up.

Matt

**snb** · 12-13-2011, 08:54 AM

Sub snb()
 On Error Resume Next
 For Each cl In Columns(12).SpecialCells(2)
  if cl.row>11 then 
    x1 = Columns(6).Find(cl.Value, , xlValues, xlWhole)
    If IsEmpty(x1) Then Columns(6).Find("", , xlValues, xlWhole).Value = cl
  end if
 Next
 Columns(12).ClearContents
End Sub

**Launchnet** · 12-13-2011, 09:08 AM

Hi snb . . .

I tested your code and nothing happens until the code line that clears column 12. I did not run the last line as I did not want to clear my data yet.

The previous code submitted by rylo allows me to change my range, which is good, as I have 11 header rows, so I start at L12:L.

So, back to my post #9 which I think explains my desired changes.

Matt

**JohnM3** · 12-13-2011, 12:02 PM

Hi

This ain't pretty but appears to work ... think of as temp solution.
I modified previous code ....

Its a no no to do a SELECT but nevertheless .... change as you see fit.

my bad - i should be a long

regards
John


Sub aaa()

  Dim i As Long  'changed this to long 
  Dim LR As Long
  Dim ce As Excel.Range
  
  Sheets("SHEET1").Select

  LR = Cells(Cells.Rows.Count, "F").End(xlUp).Row
  
  For i = 1 To LR

    For Each ce In Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row)
      If WorksheetFunction.CountIf(Range("F:F"), ce) > 0 Then
        ce.Delete shift:=xlUp
        Exit For
      End If

    Next 

  Next

End Sub

**snb** · 12-13-2011, 09:22 AM

I amended the previous code to your requirements.

**Launchnet** · 12-13-2011, 02:55 PM

Hi snb . . .

2 things . . . First, I failed to tell you that there is a header on the sheet down thru row 11. So all data starts on row 12.

Second, It appears that all non dups from column L are moved to column F. Problem, is that column L needs to be cleared from row 12 down.

I tried a blank cell within the data in row L. It seemed to skip over this OK. I do not want a blank moved over to column F

Matt

**Launchnet** · 12-13-2011, 03:10 PM

Good Morning JohnM3 . . .

he 1st time I run your code it went until it ran into a blank cell in the middle of my test data in row L - then stopped.

The 2nd time I tried again and it does nothing.

Remember, when finished, all the non-dups should be in column F and column L should be blank

Additionally, rows 1 thru 11 is my dashboard and all data starts on row 12 and down

Thanks for trying.

Matt

**JohnM3** · 12-13-2011, 09:15 PM

Hi L

I think I am in 'over' my head -g- so not certain I can get you all the way there.

Notwithstanding - this might get you closer.

Note:
Column F contains the Permanent Names (in my test) A->F
Column L contains potential dupes (in my test) A->Z (with a few blanks interspersed)

regards
John


Sub aaa_V2()

    Dim lng As Long
    Dim LR As Long
    Dim oCell As Excel.Range
    Dim WSName As String
  
    '--------------------------
    '   Its a no no to SELECT
    '--------------------------
    WSName = "Sheet1"
    Sheets(WSName).Select
    
    '--------------------------
    '   Last Row of Permanent
    '--------------------------
    LR = Cells(Cells.Rows.Count, "F").End(xlUp).Row
  
    '--------------------------
    '   Kill Dupes
    '--------------------------
    For lng = 1 To LR
        For Each oCell In Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row)
            If WorksheetFunction.CountIf(Range("F:F"), oCell) > 0 Then
                oCell.Delete shift:=xlUp
                Exit For
            End If
        Next
    Next

    '--------------------------
    '   Kill Blanks
    '--------------------------
    Set oCell = Nothing
    For Each oCell In Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row)
        If oCell.Value = vbNullString Then
            oCell.Delete shift:=xlUp
        End If
    Next

End Sub

**Launchnet** · 12-13-2011, 11:20 PM

Hi JohnM3 . . .

It appears you are close.

Here is what is missing as far as I can tell:
Rows 1 thru 11 make up my dashboard. Data starts on row 12 and goes down. All testing for dups and blanks can not effect rows 1 thru 11. Have to test from row 12 and down.

All the non-dups in L should be appended to column F.

Code that is working.
All the Dups between L & F are being deleted.

All the blanks are being deleted in L

Suggestions:

I think it best to re-code as it will be much easier.

Best to start at last row of data in L and go up until 1st cell with data.
Test the data cell in L - If row = 11 stop (completed)
Test 1 cell at a time for dup or blank. If blank, delete blank and move up 1 cell. If cell has dup in F, then delete cell in L. If cell has non-dup data, then cut data and paste to bottom of F's data. Cut means to also clear the dupe data in L.
Continue looping until test for row = 11, then stop (completed).

I know what to do, but don't know how to code it.

Thanks

**JohnM3** · 12-14-2011, 05:22 AM

Hi L

Your killing me -g-

I would wait for elegant code to show up ..... in the meantime here is some
meat and potatoes stuff

regards
John

Sub aaa_V3()

    Const CON_PERM_START_RANGE As String = "F12"
    Const CON_PERM_START_COLUMN As String = "F"

    Const CON_DUPES_START_RANGE As String = "L12"
    Const CON_DUPES_START_COLUMN As String = "L"

    Dim lng As Long
    Dim LR As Long
    Dim PermRowCNT As Long
    Dim DupeRowCNT As Long
    Dim oCell As Excel.Range
    Dim WSName As String
  
    '--------------------------------
    '   Stuff to define Perm Range
    '--------------------------------
    Dim RngPerm_StartCell As Excel.Range
    Dim RngPerm_EndCell As Excel.Range
    Dim RngPerm As Excel.Range
  
    '--------------------------------
    '   Stuff to define Dupes Range
    '--------------------------------
    Dim RngDupes_StartCell As Excel.Range
    Dim RngDupes_EndCell As Excel.Range
    Dim RngDupes As Excel.Range
  
    '--------------------------
    '   Its a no no to SELECT
    '--------------------------
    WSName = "Sheet1"
    Sheets(WSName).Select
  
    '--------------------------------
    '   Stuff to define Perm Range
    '--------------------------------
    Set RngPerm_StartCell = Range(CON_PERM_START_RANGE)
    Set RngPerm_EndCell = Cells(Rows.Count, CON_PERM_START_COLUMN).End(xlUp)
    Set RngPerm = Range(RngPerm_StartCell.Address, _
                        RngPerm_EndCell.Address)
    
    '--------------------------------
    '   Stuff to define DUPES Range
    '--------------------------------
    Set RngDupes_StartCell = Range(CON_DUPES_START_RANGE)
    Set RngDupes_EndCell = Cells(Rows.Count, CON_DUPES_START_COLUMN).End(xlUp)
    Set RngDupes = Range(RngDupes_StartCell.Address, _
                        RngDupes_EndCell.Address)
  
    '--------------------------------
    '   Last Row in Perm Range
    '--------------------------------
    PermRowCNT = RngPerm.Rows.Count
  
    '--------------------------
    '   Kill Dupes
    '--------------------------
    For lng = 1 To PermRowCNT
        '--------------------------
        '   Each Dupe Cell
        '--------------------------
        For Each oCell In RngDupes.Cells
            '--------------------------
            '   > 0 means Dupe Found
            '--------------------------
            If WorksheetFunction.CountIf(Range(RngPerm.Address), oCell) > 0 Then
                oCell.Delete shift:=xlUp
                Exit For
            End If
        Next
    Next

    '--------------------------
    '   Kill Blanks - Perm Range
    '--------------------------
    Set oCell = Nothing
    For Each oCell In Range(RngPerm.Address)
        If oCell.Value = vbNullString Then
            oCell.Delete shift:=xlUp
        End If
    Next

    '--------------------------
    '   Kill Blanks - Dupes Range
    '--------------------------
    Set oCell = Nothing
    For Each oCell In Range(RngDupes.Address)
        If oCell.Value = vbNullString Then
            oCell.Delete shift:=xlUp
        End If
    Next

    '--------------------------
    '--------------------------
    Set oCell = Nothing

    '--------------------------
    '   There could still be blanks in Dupes
    '--------------------------
    Set RngDupes_StartCell = Range(CON_DUPES_START_RANGE)
    Set RngDupes_EndCell = Cells(Rows.Count, CON_DUPES_START_COLUMN).End(xlUp)
    Set RngDupes = Range(RngDupes_StartCell.Address, _
                        RngDupes_EndCell.Address)

    '--------------------------
    '   Again - Kill Blanks in Dupes Range
    '--------------------------
    DupeRowCNT = RngDupes.Rows.Count
    For lng = 1 To DupeRowCNT
        For Each oCell In Range(RngDupes.Address)
            If oCell.Value = vbNullString Then
                oCell.Delete shift:=xlUp
                Exit For
            End If
        Next
    Next


End Sub

**rylo** · 12-13-2011, 11:31 PM

Matt

Attach an example file. I can think of another way to do this, but want to see your structure before persuing.

rylo

**huuthang_bd** · 12-14-2011, 06:29 AM

Hi Launchnet,
You can test with this code.

PHP Code:


Sub Test()

Application.ScreenUpdating = False

Dim i As Long

For i = Cells(Rows.Count, 12).End(xlUp).Row To 12 Step -1

    If Cells(i, 12).Value = "" Or Not ([F:F].Find(Cells(i, 12).Value, [F1], xlValues, xlWhole) Is Nothing) Then Cells(i, 12).Delete xlUp

Next

Application.ScreenUpdating = True

End Sub

**JohnM3** · 12-14-2011, 01:10 PM

Hi H

Great code! Thanks for posting it.

I tested it and it works on my test thingie.

regards
John

**JohnM3** · 12-14-2011, 01:22 PM

Hi H

Just an fyi ....

If you put letters A thru F in column F (the perm guys) starting at row 12

EDIT
And put A thru Z in column L (the dupe guys) starting at row 12

And then insert a blank line a rows 14 and 16 ... the L column won't contain
any blanks but the F column will ....

Not certain if this matters

regards
John

**huuthang_bd** · 12-14-2011, 10:10 PM

Hi JohnM3
I have tested with your example. It still works correctly.
Can you attach an example file?

**JohnM3** · 12-15-2011, 09:33 AM

Hi H

The WB is attached (I hope).

Sheet1 is the test sheet and sd come up active when u launch the
WB. Your code is the 1st subroutine in the module. Again - thank you
very much for posting that code - its great stuff.

regards
John

**Launchnet** · 12-15-2011, 08:09 AM

Sorry Gentlemen, but I had to be away for a couple of days. I see all you that have been active and I appreciate everyones work.

Rylo suggested a workbook which I have attached.

Please test and review your ideas.

I have tried all the code except the last code from JohnM3 and the code from huuthang_bd.

Since I had to be gone for a couple of days, I feel it best that I get this example workbook to you all prior to my doing any more testing, which I will do.

Hope the file uploaded. This upload proceedure is all new to me.

Many Thanks

**Launchnet** · 12-15-2011, 01:49 PM

I ran your test code and it removes the blanks in column L.

This can easily be done by selecting all the data in L and sort L "Ascending. This automatically places all the blanks at the bottom of the list.

I also ran your Sub Main () after removing dups. Nothing happens.

Then I ran Sub aaa_V2() and it appears that all the dups were deleted from L compared with F. The problem here is that some of the data in L is in rows 6 thru 11, which can not happen.

What happens if L has dups within L

Secondly, it does not combine L data into F data, which it should.

There should never be any blanks in F. But if there were, I can not see any problem if there were. If there would be, I would simply add a sort to column F.

When Sub Test() is finished, I could call Sub Main() at the end of Sub Test().

I know that you understand that this still does not answer my problem. Please see my sample sheet I just sent a few minutes ago.

**JohnM3** · 12-15-2011, 03:18 PM

Hi L

I don't know if you were writing to me - but my attachment to Huu has a sub called Main.
So if you were.

You wrote:

<< it removes the blanks in column L.
This can easily be done by selecting all the data in L and sort L "Ascending. This automatically places all the blanks at the bottom of the list. >>

Correct. But your _previously_ wrote

<<
Looks good, but I have one question. sometimes there are blanks in column 12 before getting to the end of the data. My question is "Will this work with blanks"? If so, then how does the macro know when to stop at the end of the data?

I for got to mention that neither list is in alpha-numeric order.

It would be nice if the blanks in column 12, between the 1st and last values were to be removed so that 12 has a continious list of values would be great.
>>

The above suggested to me that values were _not_ going to be sorted and _blanks_ had to be
dealt with.

[[ I took it a step further and said what-if there are blanks in BOTH columns F and L ]]

You wrote:

<< I also ran your Sub Main () after removing dups. Nothing happens>>

Correct. Its dead code. Just does not work.

My attachment to H was at his request in that the WB contains his routine and my followup that
blanks remained in column F. He wanted to see "how" I was testing because his tests yielded
a different result. IOW - I could have been testing incorrectly. So I sent him the WB.

My last submission to you was:

Sub aaa_V3()

It will - as far as I know from testing - kill blanks in BOTH columns F and L.

Below is my final submission:

- It kills blanks in columns F and L.
- Duplicates in column L.
- It hard codes their start positions (previous) post of Columns F and L.

-- I added this .....

- It moves remaining L under F.
- It kills L.

The code is below - but understand - my code is a "kill baby-seals with a club" approach. The code
(the approach - the intellect) by Rylo and Huuthang is much more elegant, much lighter footprint, and just
plain "smarter". I hung on this thread because I "admired" the code that Rylo had posted. And still
do. Ditto for Huuthang. His code is lights out great code.

regards
John

FWIW

Sub aaa_V3()

    'Modified 12/15/2011

    Const CON_PERM_START_RANGE As String = "F12"
    Const CON_PERM_START_COLUMN As String = "F"

    Const CON_DUPES_START_RANGE As String = "L12"
    Const CON_DUPES_START_COLUMN As String = "L"

    Dim WSName As String
    Dim lng As Long
    Dim LR As Long
    Dim PermRowCNT As Long
    Dim DupeRowCNT As Long
    Dim oCell As Excel.Range
    Dim oLastCellColF As Excel.Range
    Dim oNextCellAfterLastCellColF As Excel.Range
  
    '--------------------------------
    '   Stuff to define Perm Range
    '--------------------------------
    Dim RngPerm_StartCell As Excel.Range
    Dim RngPerm_EndCell As Excel.Range
    Dim RngPerm As Excel.Range
  
    '--------------------------------
    '   Stuff to define Dupes Range
    '--------------------------------
    Dim RngDupes_StartCell As Excel.Range
    Dim RngDupes_EndCell As Excel.Range
    Dim RngDupes As Excel.Range
  
    '--------------------------
    '   Its a no no to SELECT
    '--------------------------
    WSName = "Sheet1"
    Sheets(WSName).Select
  
    '--------------------------------
    '   Stuff to define Perm Range
    '--------------------------------
    Set RngPerm_StartCell = Range(CON_PERM_START_RANGE)
    Set RngPerm_EndCell = Cells(Rows.Count, CON_PERM_START_COLUMN).End(xlUp)
    Set RngPerm = Range(RngPerm_StartCell.Address, _
                        RngPerm_EndCell.Address)
    
    '--------------------------------
    '   Stuff to define DUPES Range
    '--------------------------------
    Set RngDupes_StartCell = Range(CON_DUPES_START_RANGE)
    Set RngDupes_EndCell = Cells(Rows.Count, CON_DUPES_START_COLUMN).End(xlUp)
    Set RngDupes = Range(RngDupes_StartCell.Address, _
                        RngDupes_EndCell.Address)
  
    '--------------------------------
    '   Last Row in Perm Range
    '--------------------------------
    PermRowCNT = RngPerm.Rows.Count
  
    '--------------------------
    '   Kill Dupes
    '--------------------------
    For lng = 1 To PermRowCNT
        '--------------------------
        '   Each Dupe Cell
        '--------------------------
        For Each oCell In RngDupes.Cells
            '--------------------------
            '   > 0 means Dupe Found
            '--------------------------
            If WorksheetFunction.CountIf(Range(RngPerm.Address), oCell) > 0 Then
                oCell.Delete shift:=xlUp
                Exit For
            End If
        Next
    Next

    '--------------------------
    '   Kill Blanks - Perm Range
    '--------------------------
    Set oCell = Nothing
    For Each oCell In Range(RngPerm.Address)
        If oCell.Value = vbNullString Then
            oCell.Delete shift:=xlUp
        End If
    Next

    '--------------------------
    '   Kill Blanks - Dupes Range
    '--------------------------
    Set oCell = Nothing
    For Each oCell In Range(RngDupes.Address)
        If oCell.Value = vbNullString Then
            oCell.Delete shift:=xlUp
        End If
    Next

    '--------------------------
    '--------------------------
    Set oCell = Nothing

    '--------------------------
    '   There could still be blanks in Dupes
    '--------------------------
    Set RngDupes_StartCell = Range(CON_DUPES_START_RANGE)
    Set RngDupes_EndCell = Cells(Rows.Count, CON_DUPES_START_COLUMN).End(xlUp)
    Set RngDupes = Range(RngDupes_StartCell.Address, _
                        RngDupes_EndCell.Address)

    '--------------------------
    '   Again - Kill Blanks in Dupes Range
    '--------------------------
    DupeRowCNT = RngDupes.Rows.Count
    For lng = 1 To DupeRowCNT
        For Each oCell In Range(RngDupes.Address)
            If oCell.Value = vbNullString Then
                oCell.Delete shift:=xlUp
                Exit For
            End If
        Next
    Next

    '==========================
    '   12/15/2011
    '==========================
    '   Added to move L to F
    '==========================
    
    '--------------------------------
    '   Perm Range
    '--------------------------------
    Set RngPerm_StartCell = Range(CON_PERM_START_RANGE)
    Set RngPerm_EndCell = Cells(Rows.Count, CON_PERM_START_COLUMN).End(xlUp)
    Set RngPerm = Range(RngPerm_StartCell.Address, _
                        RngPerm_EndCell.Address)

    '--------------------------------
    '   Last Cell in F
    '--------------------------------
    Set oLastCellColF = RngPerm.Rows(RngPerm.Rows.Count)
    
    '--------------------------------
    '   Next Row
    '--------------------------------
    Set oNextCellAfterLastCellColF = oLastCellColF.Offset(1, 0)

    '--------------------------------
    '   DUPES Range
    '--------------------------------
    Set RngDupes_StartCell = Range(CON_DUPES_START_RANGE)
    Set RngDupes_EndCell = Cells(Rows.Count, CON_DUPES_START_COLUMN).End(xlUp)
    Set RngDupes = Range(RngDupes_StartCell.Address, _
                        RngDupes_EndCell.Address)

    '--------------------------------
    '   Copy Dupes
    '--------------------------------
    RngDupes.Copy
    
    '--------------------------------
    '   Paste to First Empty F Cell
    '--------------------------------
    With oNextCellAfterLastCellColF.Cells(1)
        .PasteSpecial , True
    End With

    '--------------------------------
    '   Kill Dupes
    '--------------------------------
    With RngDupes
        .ClearContents
    End With

    Exit Sub

End Sub

**Launchnet** · 12-15-2011, 03:30 PM

Yes JohnM3 . . . I was writing to you. I see the problem now. You have been communicating to H from my post. This should never be done as it causes much confusion.

If H has questions or needs help from anyone on this post, he should create his own post.

My post is now becoming confusing to everyone.

**JohnM3** · 12-15-2011, 04:27 PM

Hi L

I see. My bad. Sorry.

If blanks in column L are not an issue - because L will be sorted so as to kill them off - then the
first solution rylo gave you will work. Additionally, the solution that Huuthang submitted will
work. Both versions of their code are much *stronger* than mine.

You will have to contact them and request that they add the final part which is
moving column L to F and killing off column L.

regards
John

**rylo** · 12-15-2011, 06:54 PM

Matt

Try this.

Sub aaa()
  Dim DataSH As Worksheet, TempSH As Worksheet
  Set DataSH = Sheets("Test Check Dups")
  Sheets.Add after:=Sheets(Sheets.Count)
  Set TempSH = ActiveSheet
  
  Range("A1").Value = "H1"
  
  DataSH.Activate
  Range("F12:F" & Cells(Rows.Count, "F").End(xlUp).Row).Copy Destination:=TempSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  Range("L12:L" & Cells(Rows.Count, "L").End(xlUp).Row).Copy Destination:=TempSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  TempSH.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=TempSH.Range("B1"), unique:=xlYes
  TempSH.Range("B:B").Sort key1:=TempSH.Range("B1"), Header:=xlYes
  TempSH.Range("B2:B" & TempSH.Cells(Rows.Count, 2).End(xlUp).Row).Copy
  Range("F12").PasteSpecial (xlPasteValues)
  Range("L12:L" & Cells(Rows.Count, "L").End(xlUp).Row).ClearContents
  
  Application.DisplayAlerts = False
  TempSH.Delete
  Application.DisplayAlerts = True

End Sub

There is a slight difference to your output as you have manually doubled up on the entry for Frank Galvan in column F.

rylo

**Launchnet** · 12-15-2011, 08:11 PM

Hi Rylo . . .

I have run 4 tests so far and . . . IT WORKS GREAT.

What else can I say. Fantastic and Fast. I'd like to be your friend. Time and time again, you and Leith Ross have come thru on the tough ones and your code is clean and short. God Bless both of you and Merry Christmas.

**huuthang_bd** · 12-16-2011, 01:01 AM

Hi Jonh M3
I'm sorry. I have misunderstood you because my English is very bad.
You can try with this code if you want delete blank cells in column F.

PHP Code:


Sub Test()
    Application.ScreenUpdating = False
    Dim i As Long
    For i = Cells(Rows.Count, 6).End(xlUp).Row To 12 Step -1
        If Cells(i, 6).Value = "" Then Cells(i, 6).Delete xlUp
    Next
    For i = Cells(Rows.Count, 12).End(xlUp).Row To 12 Step -1
        If Cells(i, 12).Value = "" Or Not ([F:F].Find(Cells(i, 12).Value, [F1], xlValues, xlWhole) Is Nothing) Then Cells(i, 12).Delete xlUp
    Next
    Application.ScreenUpdating = True
End Sub

**Launchnet** · 12-16-2011, 01:48 AM

Hi H . . .

This is Matt @ Launchnet. Just so you know, the post is mine. No problems there. Please note #30. The code works. I am going to continue testing just to be sure. In the mean while, I will also test your code. I would like to acknowlede that yours also works. Thanks for all the work you've done. Everyone will hear soon.

**huuthang_bd** · 12-16-2011, 03:21 AM

Hi Launchnet
In post #32, I just discussed with JonhM3. I'm sorry if you feel uncomfortable.
I have seen post #30 and i think may be this code work better

PHP Code:


Sub Test()
Dim Dic, Arr, Result(), Rng As Range, i As Long, j As Long, Temp As String
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Range([F12], [F65536].End(xlUp).Offset(2))
Arr = Rng.Value
For i = 1 To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then
        If Not Dic.Exists(Arr(i, 1)) Then Dic.Add Arr(i, 1), ""
    End If
Next
Rng.ClearContents
Set Rng = Range([L12], [L65536].End(xlUp).Offset(2))
Arr = Rng.Value
For i = 1 To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then
        If Not Dic.Exists(Arr(i, 1)) Then Dic.Add Arr(i, 1), ""
    End If
Next
Rng.ClearContents
If Dic.Count = 0 Then Exit Sub
Arr = Dic.keys
For i = 0 To UBound(Arr) - 1
    For j = i + 1 To UBound(Arr)
        If LCase(Arr(j)) < LCase(Arr(i)) Then
            Temp = Arr(j): Arr(j) = Arr(i): Arr(i) = Temp
        End If
    Next
Next
ReDim Result(1 To UBound(Arr) + 1, 1 To 1)
For i = 0 To UBound(Arr)
    Result(i + 1, 1) = Arr(i)
Next
[F12].Resize(UBound(Result, 1)).Value = Result
End Sub

regards
HuuThang

How to Compare Column 12 to values in column 6 while deleting dups from column 12

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Re: How to Compare Column 12 to values in column 6 while deleting dups from column 12

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions