VBA - Count Two Column's Duplicate Values and Tagged it

Question

I'm doing a program where i need to count the duplicate values from Column A and Column B if the duplicate value from both columns are greater than 1 tag it in two columns, the first column as "selected" the second one is "updated" the one that will be tagged in the duplicate values is the date that closest to current date..

Example:

Column A| Column B| Column C | Column D| Column E|
  1     |  easy   | 1/2/2016 |         |         |
  2     |  normal | 1/3/2016 |         |         |
  2     |  hard   | 1/4/2016 |         |         |
  1     |  easy   | 1/5/2016 |         |         |

Output:

Column A| Column B| Column C | Column D | Column E|
      1 |  easy   | 1/2/2016 |          |         |
      2 |  normal | 1/3/2016 |          |         |
      2 |  hard   | 1/4/2016 |          |         |
      1 |  easy   | 1/5/2016 | selected | updated |

In the sample output above Column A and B have duplicate values which 1 and easy row 4 have been tagged as Selected and updated because its the closest date today.. if column A and B are not the same value like 1,normal and 1 ,hard no action done

My code(EDITED):

    Sub sample1()

    Dim i As Long, lastRow As Long, countRow As Long, countRow1 As Long
    Dim Var1 As Integer

    With Worksheets("Sheet1")

   lastRow = .Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To lastRow
            countRow = Application.CountIf(.Columns(1), .Cells(i, 1))
            countRow1 = Application.CountIf(.Columns(2), .Cells(i, 2))

            If countRow > 2 Then
                If Not CBool(Application.CountIfs(.Columns(1), .Cells(i, 1), _
                                        .Columns(3), ">" & .Cells(i, 3))) Then _
                    .Cells(i, 4) = "selected"

            If countRow1 > 2 Then
                If Not CBool(Application.CountIfs(.Columns(2), .Cells(i, 2), _
                                        .Columns(3), ">" & .Cells(i, 3))) Then _

                    .Cells(i, 5) = "updated"
           End If
            End If
            End If
        Next
    End With

End Sub

The countifs is now working by one column only what i need is a pair of duplicate values in a two column, like in the sample output: Column A and Bthe value 1 and easyare the same in row 2 and 4 that why its been tag my code tag them separetely. please help me about this!

You'll want to post the code that you're having trouble with. If we can't see it, we can't fix it! — BobRodes
– BobRodes, Commented Mar 18, 2016 at 7:37
@BobRodes thanks for the quick reply :) the my code: above is the code i having problem wtih — 7A65726F
– 7A65726F, Commented Mar 18, 2016 at 7:41
The code you've posted is the code to count column A, that @Jeeped provided for you, isn't it? Where is the result of the hours of trial and error that you've been working on? — BobRodes
– BobRodes, Commented Mar 18, 2016 at 7:50
The first thing you need to do with this is make sure that you have one End If for each If. Then, you have to ask yourself why you are evaluating "Countrow > 1" three times, since you only need to do it once. It will help if you get your indentations correct. — BobRodes
– BobRodes, Commented Mar 18, 2016 at 18:38

user4039065 · Accepted Answer · 2016-03-21 02:38:57Z

2

There were some lines of code that I couldn't reconcile so I've removed them in order to provide a simplified solution.

Sub two_column_dated_duplicates()
    Dim i As Long, lastRow As Long

    With Worksheets("Sheet1")
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To lastRow
            If Application.CountIfs(.Columns(1), .Cells(i, 1), _
                                          .Columns(2), .Cells(i, 2)) > 1 Then
                If Not CBool(Application.CountIfs(.Columns(1), .Cells(i, 1), _
                                                  .Columns(2), .Cells(i, 2), _
                                                  .Columns(3), ">" & .Cells(i, 3))) Then
                    .Cells(i, 4).Resize(1, 2) = Array("selected", "updated")
                End If
            End If
        Next
    End With
End Sub

^{Data before two_column_dated_duplicates()} ^{Data after two_column_dated_duplicates()}

answered Mar 21, 2016 at 2:38

user4039065

Sign up to request clarification or add additional context in comments.

4 Comments

7A65726F Over a year ago

in column .column(2) i only need to count the value "change modem" how can i insert the change modem in the code you provide? btw thanks your code is much easier to understand :)

user4039065 Over a year ago

As soon as you enter the For Next loop, put an If .Cells(i, 2).Value = "change modem" Then and finish it off with an end if just before the Next i. You might want to use lcase(.Cells(i, 2).Value) = "change modem" as VBA is case sensitive by default.

7A65726F Over a year ago

Question, in what part of this code get the closest date in the column today?

user4039065 Over a year ago

It is the second countifs. It counts the dates that are later than column C where B:B=B and A:A=A. If there are no dates larger then that one must be the latest date.

AndyW · Accepted Answer · 2016-03-18 08:47:42Z

0

countRow seems to be the problem. You are reading it a lot in the If statements but you do not seem to be setting it anywhere. I am guessing that you are taking the current entry and counting how many entries of that value are in the column. If there are more than one entry then there are duplicates In which case I am guessing that your problem line is

columnA = Application.CountIf(.Column(1), .Cells(i, 1))

Should this not be

countRow= Application.CountIf(.Column(1), .Cells(i, 1))

Your indentation could be better to make it easier to read. Also you have:

If countRow > 1 Then
Else         If countRow > 1 Then
End If"

Your If and Else have the same conditions. I cannot see what the Else is doing since it will simply set columnA (countRow?) that has already been set.

You also seem to have 2 loops doing, essentially, the same thing.

You have a variable i that is read but never set and seems to be a duplicate rowcounter

I think you need to start again and understand what the code needs to do. In pseudocode you want this:

Loop through every row in the table
  if Count of data in current row, column 1 > 1 then
    if Count of data in current row, column 2 > 2 then
        set current row, column 4 = "Selected"
        set current row, column 5 = "Updated"
     endif
   endif
end loop

Your code should only be 10 or 12 lines and involve a single loop with a coupled of nested ifs.

edited Mar 18, 2016 at 8:47

answered Mar 18, 2016 at 8:34

AndyW

4506 silver badges19 bronze badges

4 Comments

7A65726F Over a year ago

what about the column B?

AndyW Over a year ago

You have Frankencode where some routines have been jammed together and you have not streamlined them. You have 2 variables holding the current rownumber - rowNo and i You have write only variables You are writing a range to Columns A and B and the overwriting with an integer value without ever reading the existing value. You are writing the same values to the same cells twice using two almost identical if statements. Honestly I would start again from scratch with psuedocode and build from there

user4039065 Over a year ago

If the changes in requirements are sufficient to 'break' suggested solutions that meet the previous requirements, then yes, a new question should be posted.

AndyW Over a year ago

You seem to be missing criterion for the first part of the countifs Have a look at the docs on COUNTIFS, The syntax should be =COUNTIFS(<range1>,<criterion1>, <range2>, <criterion2>...) your criteria should be ">1" and ranges are the columns. I think that your second IF statement is unecessary, My pseudocode was based in 2 separate check but COUNTIFS combined these into one.

Collectives™ on Stack Overflow

VBA - Count Two Column's Duplicate Values and Tagged it

2 Answers 2

4 Comments

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related