I am trying to find non-unique values ​​in the column and mark them. Found "conditional formatting -> cell selection rules -> duplicate values"

Based on this functionality generated a macro. Tell me how to change the macro to add a comment to the specified cell of the line that the information is duplicated. Could not understand the logic of this macro.

Sub Tst() Columns("D:D").Select Selection.FormatConditions.AddUniqueValues Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).DupeUnique = xlDuplicate With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False End Sub
  • Unclear formulation of the problem. Need to change the background of those cells whose value appears in the column only once? I understood that way. And the phrase is not clear to change the macro so that to add a comment to the specified cell of the line - not only is it not Russian, so it seems to me that there is an intention to change the data in the cell ... then, by the way, it could theoretically duplicate. - Akina
  • Changed the question (need duplicates), poorly written. It is necessary to find duplicates and write a comment in the next cell. I wanted to modify the created macro, but did not understand how - Viktorov

2 answers 2

how to change the macro ... It is necessary to find duplicates and write a comment in the next cell

There is no need to refine, but to change the approach. First, fill in conditional formatting, then try to determine duplicates using this formatting ...

Simpler. According to the values ​​we go ... and we find :)

Work with leaf objects is slow, therefore it is better to process in memory.

Check the values ​​of column D. In column E, write the row numbers of duplicates found.

 Sub Tst() Dim Ar() Dim lRws As Long Dim i As Long, k As Long With ActiveSheet lRws = .Cells(.Rows.Count, 4).End(xlUp).Row ' последняя заполненная ячейка Ar = .Range("D1:D" & lRws).Value ' значения в массив ReDim Preserve Ar(1 To lRws, 1 To 2) ' расширяем размерность для комментариев For i = 1 To lRws - 1 ' цикл по проверяемым значениям If Ar(i, 1) <> Empty Then ' значение есть For k = i + 1 To lRws ' цикл по сравниваемым значениям If Ar(i, 1) = Ar(k, 1) Then ' нашли дубль ' записываем комментарий - номера строк с дублями Ar(i, 2) = Ar(i, 2) & "/" & k Ar(k, 2) = Ar(k, 2) & "/" & i End If Next k End If Next i .Range("D1:E" & lRws).Value = Ar ' выгрузка на лист End With End Sub

The code below will mark duplicate values:

 Sub SearchOfTakes() Dim rRng As Range, c As Range Dim oDict As Object Dim lRws As Long With ActiveSheet lRws = .Cells(.Rows.Count, 4).End(xlUp).Row ' последняя заполненная ячейка Set rRng = .Range("D1:D" & lRws) ' диапазон в переменную Set oDict = CreateObject("scripting.dictionary") ' словарь For Each c In rRng ' цикл по ячейкам диапазона If c.Value <> "" Then ' значение есть If oDict.exists(c.Value) Then ' если значение было раньше c.Offset(, 1) = "дубль" ' отмечаем его Else ' значение первый раз в диапазоне Set oDict(c.Value) = c ' в словарь End If End If Next c End With End Sub
  • Thanks for the tip. Maybe ... The task is incomprehensible. Suddenly critical? - vikttur
  • Why delete? After all, the necessary information ... - vikttur
  • Add an answer with additions. so it will be more correct. - vikttur

Select a range (or the entire column). Open Conditional Formatting. Choose the condition "Formula". In the condition field enter

 =ЕСЛИ(СЧЁТЕСЛИ(A:A;A1)=1;ЛОЖЬ;ИСТИНА)

Replace A: A with the address of the column (say, in your case it will be D: D) or range (for example D1: D58). Replace A1 with the address of the upper-most left cell of the range (say, it will be D1). Set the required format (for example, red background). Click OK.

In VBA terms, this will be

 Range("D:D").Select Selection.FormatConditions.Delete Selection.FormatConditions.Add _ Type:=xlExpression, _ Formula1:="=ЕСЛИ(СЧЁТЕСЛИ(D:D;D1)=1;ЛОЖЬ;ИСТИНА)" Selection.FormatConditions(1).Interior.ColorIndex = vbRed
  • Enough: = ACCOUNTS (A: A; A1) = 1 Excel will figure it out further) - vikttur