I have a fairly simple For loop that is looking at 2 columns - NAME and JOB. If there are comma delimited names in a cell, it triggers a function that inserts each name one row below, and then takes the number of new rows and adds it to the last row value (minus 1). Then, if there is no JOB next to that name, it uses the JOB value +1 above.
Problem I am running into is that even though I can see that the LastRow value is being added to as I step through, the loop still exits after it reaches the original LastRow value when the loop began.
i.e. if LR = 100 at the beginning of the loop, but because of CountUnique, LR now = 115, the loop still exits after 100.
I cannot figure out why.
LR = Range("B" & Rows.Count).End(xlUp).Row
' Mirror missing attributes
For i = 2 To LR
If InStr(Cells(i, 2).Value, ",") Then
LR = LR + CountUnique(Cells(i, 2)) - 1
End If
If Cells(i, 1).Value = "" Then
Cells(i, 1).Value = Cells(i - 1, 1).Value
End If
Next i
Public Function CountUnique(r As Range) As Integer
Dim c As Collection
Set c = New Collection
ary = Split(r.Text, ",")
On Error Resume Next
For Each a In ary
c.Add a, CStr(a)
If Err.Number = 0 Then
If CountUnique >= 1 Then
r.Offset(CountUnique, 0).EntireRow.Insert
r.Offset(CountUnique, 0).Value = Trim(a)
End If
CountUnique = CountUnique + 1
Else
Err.Number = 0
End If
Next a
r.Value = c.Item(1)
End Function
In VB, the boundaries of the For loop are evaluated once at the start and the values are cached.
If you want a dynamic upper bound, you need to use a Do loop.
Related
I have two columns of data on the same worksheet.
I want to compare all the values in column B to the last value in column A. If they are the same, call a certain function. Then move to the next value in column A, and compare to all values in B again, etc.
Sub FindSamples()
Dim first As String
Dim second As String
Dim j As Long
Dim i As Long
Dim lastRowNumber As Long
Dim lastRowNumberDDH As Long
With Sheets("Shape Point Info")
lastRowNumber = .Cells(Rows.Count, 1).End(xlUp).Row
lastRowNumberDDH = .Cells(Rows.Count, 20).End(xlUp).Row
For i = lastRowNumberDDH To 0 Step -1
For j = lastRowNumber To 0 Step -1
second = Cells(j, 4).Value
first = Cells(i, 20).Value
If first = second Then
'Call something
Worksheets("Shape Point Info").Range("J14").Value = "Yes"
Else:
End If
Next j
Next i
End With
End Sub
My errors are on lines 17 and 18 of my code:
second = Cells(j, 4).Value
first = Cells(i, 20).Value
I get
"Run time error 1004: Application-defined or object-defined error"
Cells, Rows, Columns, and almost all collections and items in VBA are 1-indexed. Therefore you cannot access Rows(0), and this is the issue with your code. You have to amend your For lines as such:
For i = lastRowNumberDDH To 1 Step -1
For j = lastRowNumber 1 Step -1
I am trying to compare values in two lists. I want my code to compare a value in the first list and check all the entries in the second list. If there is a match then the code will print true next to the value in the first list and if not it will print false.
The problem I am having is that my code only compares values that are in the same row.
The code runs and I have tried it on a two smaller lists to make sure the data types are to same and there aren't any extra spaces or commas in the lists that would lead to a "False" output. I have also tried changing the order of the for and if statements but this doesn't work either.
Sub findvalues()
For i = 2 To 16
For j = 2 To 16
If Cells(i, 3).Value = Cells(i, 1).Value Then
Cells(i, 4).Value = "TRUE"
ElseIf Cells(i, 3).Value = Cells(j + 1, 1).Value Then
Cells(i, 4).Value = "TRUE"
Else
Cells(i, 4).Value = "FALSE"
End If
Next j
Next i
End Sub
Here are the two lists I am testing the code on
Slight mods to your code based on the data you provided in columns 1 & 3. As always, things could be improved but this should get you going ...
Sub findvalues()
Dim i As Long, j As Long, bResult As Boolean
For i = 2 To 16
strValueToLookFor = Cells(i, 1)
For j = 2 To 16
bResult = False
If strValueToLookFor = Cells(j, 3).Value Then
bResult = True
Exit For
End If
Next j
Cells(i, 6).Value = bResult
Next i
End Sub
... you may just need to flick the columns over so the first list searches on the second list or vice versa.
I don't see any need for VBA - formulas are the way to go - but to avoid two loops one could do this:
Sub findvalues()
Dim i As Long
For i = 2 To 130
Cells(i, 4).Value = IsNumeric(Application.Match(Cells(i, 1).Value, Range("C2:C130"), 0))
Next i
End Sub
Update: this does not cater for multiple matches.
There are many was to achieve that. one of them is by using IF & COUNTIF
Formula
=IF(COUNTIF($E$2:$E$6,A2)>0,"TRUE","FALSE")
Results:
VBA CODE
Option Explicit
Sub findvalues()
Dim i As Long
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1") 'Change if needed
Set rng = .Range("A2:A130") 'set rng to includes values from column A, rows 2:130
For i = 2 To 130 'Loop from row 2 to 130
'Check if the values in column C includes in the rng
If Application.WorksheetFunction.CountIf(rng, .Range("C" & i).Value) > 0 Then
.Range("D" & i).Value = "TRUE"
Else
.Range("D" & i).Value = "FALSE"
End If
Next i
End With
End Sub
VBA code to reconcile two lists.
Sub Reconciliation()
Dim endRow As Long
Dim ICount As Long
Dim Match1() As Variant
Dim Match2() As Variant
Dim ws As Worksheet
Set ws = Worksheets("Recon")
ICount = 0
endRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
endRow1 = ws.Cells(ws.Rows.Count, 11).End(xlUp).Row
Match1 = Sheet1.Range("b2:b" & endRow)
Match2 = Sheet1.Range("K2:K" & endRow1)
For i = LBound(Match1) To UBound(Match1)
For j = LBound(Match2) To UBound(Match2)
If Match1(i, 1) = Match2(j, 1) Then
ICount = ICount + 1
Sheet1.Range("C" & i + 1).Value = ICount
Sheet1.Range("L" & j + 1).Value = ICount
Else
End If
Next j
Next i
End Sub
I have gone crazy with vba projects around the house and helping my wife upping her reports to the next level. I’m having troubles putting down to VBA what I’m thinking. If anyone has felt my pain please shed some light on the actual script that would help me over this hump. Summary might be comparing cell value for certain text using InStr and if doesn't exist the appending characters to the right end. I can append and run thru one cycle of the loop but get confused with trying to write the logic I'm thinking.
Alittle background on the report: One row equals one reservation. Within that row there is a column labeled “Nights”. This column is filtered for any reservation with more than “1” Night. Example: could be 3 nights, 6 nights, and 10 nights doesn’t matter. I have a macro that sorts these reservations and splits the one reservation into multiple rows totaling the number value in the “Nights” column. Basically, copying and inserting the rows next to each other. While this filtered is still applied (SpecialVisibleCells Only). Now I have another column labeled “ResNumber”. With 3, 6, or 10 rows split out the “ResNumber” column is the same number. I’m tasked with walking down this ‘ResNumber” column and appending a “-1” for the first row. A “-2” for the second reservation “-3” for the third and possibly a forth “-4” Until the last row of the copied for that one reservation group. Then the cycle (loop) starts again on the next group or block of rows. Same procedure.
Dim lnrow As Integer
Dim llrow As String
Dim rownuml As Integer 'row checker
Dim colnuml As String 'column checker
Dim count As Integer
Dim total As String 'Value of reservation's "Nights" column Offset(,17)
Dim startnum As Integer 'Start number for counter
Dim actcell As String 'Activecell
startnum = 1
With sh
llrow = .Cells(.Rows.count, 2).End(xlUp).row
If llrow = "" Then Exit Sub
.Cells(2, 2).Resize(llrow - 1).SpecialCells(xlCellTypeVisible).Select
For lnrow = 2 To llrow
rownuml = ActiveCell.row
colnuml = ActiveCell.Column
total = ActiveCell.offset(, 17).Value
For count = 1 To total
rownuml = ActiveCell.row
colnuml = ActiveCell.Column
actcell = ActiveCell.Value
'Compares row 1 and checks resNumber value for "-1" if none exist it appends.
If InStr(ActiveCell.Value, "-1") = 0 Then
ActiveCell.Value = ActiveCell.Value & "-1"
Else
GoTo nexrow
End If
'Compares row 2 and checks resNumber value of above cell.
If InStr(ActiveCell.offset(-1, 0).Value, "-1") = 0 Then
Resume Next
If InStr(ActiveCell.Value, "-2") = 0 Then
ActiveCell.Value = ActiveCell.Value & "-2"
GoTo nexrow
End If
'to jump out of loop nexrow
'ActiveCell moves one row down.
ActiveCell.offset(1, 0).SpecialCells(xlCellTypeVisible).Select
rownuml = ActiveCell.row 'just checking row number
colnuml = ActiveCell.Column 'just checking column number
'since 1st reservation is already in the DB startnum starts at # 1. The counter
startnum = startnum + count
Next count
Next
End With
Try:
Option Explicit
Sub test()
Dim LastRow As Long, Times As Long, Counter As Long, i As Long, y As Long
Dim strNumber As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRow
strNumber = .Range("B" & i).Value
Times = Application.WorksheetFunction.CountIf(.Range("B2:B" & LastRow), strNumber)
If Times > 1 Then
Counter = 1
For y = 2 To LastRow
If strNumber = .Range("B" & y).Value Then
.Range("B" & y).Value = strNumber & " - " & Counter
.Range("D" & y).Value = 1
Counter = Counter + 1
End If
Next y
End If
Next i
End With
End Sub
Results:
My code mostly works but it's taking a while to debug so I am beginning to think my architecture may be flawed XD So how can I architect this better?
I have groups of data separated by a blank row. You can tell each group apart by the ID in column C in addition to the blank row. For each ID, I have various numbers in column B that I need to capture. Sometimes those numbers only start with 5, sometimes it starts with 7. I need to capture the 5 and the 7 separately.
With projWS
With .Range("C1:C6000")
Set f = .Find(cc, LookIn:=xlValues, lookat:=xlPart)
End With
If Not f Is Nothing Then 'first occurence found
counter = 0
i = f.Row
Do
acct = .Cells(i, 2)
If (Len(projWS.Cells(i, 3)) < 1 Or Left(acct, 1) = "7") And done = False Then
acctStart = f.Row
acctRows = i - acctStart
Set acctRng = .Range(.Cells(acctStart, 2), .Cells(i - 1, 5))
Set amountRng = .Range(.Cells(acctStart, 7), .Cells(i - 1, 8))
done = True 'set flag to show range has been filled
End If
counter = counter + 1 'increment counter
i = i + 1 'move to next row
Loop Until Len(.Cells(i, 3)) < 1 'keep looping until blank row
End If
If counter - 1 > acctRows Then 'how we determine if there's a "7"
flag = True 'so we set flag to true
Set depreRng = Range(.Cells(acctStart + acctRows, 2), .Cells(i - 1, 8))
dep = depreRng.Value2 'store range into array
End If
End With
After capture, I need to drop it into another worksheet. This worksheet already has a block of 7 built in. Hence this is the loop I am using to drop the range of 7. There is no built in block for the 5.
For r = 112 To 120
For k = 1 To UBound(dep())
If .Cells(r, 1).Value2 = Trim(dep(k, 1)) Then
Debug.Print .Cells(r, 1).Value2
.Cells(r, 6) = dep(k, 6)
.Cells(r, 7) = dep(k, 7)
Exit For
Else
.Cells(r, 6) = 0
.Cells(r, 7) = 0
End If
Next k
Next r
I have debugged several errors already. The current one is that depreRng is breaking because my math is bad. Instead of debugging each error as I stumble onto it, how can I architect this better?
Ok, my approach it's different. First i use a filter for find the range of rows with the index you are looking for and then loop inside this filtered rows for find the 5xx and the 7xx range. The code:
Sub Macro1()
Dim rng_5xx_start, rng_5xx_stop, rng_7xx_start, rng_7xx_stop As Integer
rng_5xx_start = 0
rng_5xx_stop = 0
rng_7xx_start = 0
rng_7xx_stop = 0
Dim range_5xx, range_7xx As String
'filter for the index you are looking for
'specify the maximum range, the field is the "offset" from the column B (the firts of the range), so for filter for column C you need to put 2, criteria...is the critera :)
ActiveSheet.Range("$B$1:$H$6000").AutoFilter Field:=2, Criteria1:="b"
'the filter returns only the rows with the specifyed index, now a for inside this rows for find the 5xx and the 7xx sub-ranges
For Each Row In ActiveSheet.Range("b1:b6000").SpecialCells(xlCellTypeVisible)
If Cells(Row.Row, 2).Value > 4999 And Cells(Row.Row, 2).Value < 6000 Then
'or any test for understnd if i'm in the 5xx range, if you prefer use the strings use something like left(cells(row.row,2).value,1) = "5"
If rng_5xx_start = 0 Then 'found the first row with a 5xx value
rng_5xx_start = Row.Row 'set the start of the range to this row
End If
If rng_5xx_stop < Row.Row Then 'the row where i am is in the 5xx range and is grater than the current end i noticed
rng_5xx_stop = Row.Row 'refresh the end of the range...at the end this will have the last number of row of the 5xx range
End If
End If
If Cells(Row.Row, 2).Value > 6999 And Cells(Row.Row, 2).Value < 8000 Then
'same as above but for 7xx range
If rng_7xx_start = 0 Then
rng_7xx_start = Row.Row
End If
If rng_7xx_stop < Row.Row Then
rng_7xx_stop = Row.Row
End If
End If
Next
If rng_5xx_start = 0 Then
'not found 5xx rows
range_5xx = "" 'or False, or what you prefer...
Else
range_5xx = "B" & rng_5xx_start & ":H" & rng_5xx_stop
End If
If rng_7xx_start = 0 Then
'not found 7xx rows
range_7xx = "" 'or False, or what you prefer...
Else
range_7xx = "B" & rng_7xx_start & ":H" & rng_7xx_stop
End If
End Sub
That's how i would imagine a macro for your job ;)
Edit 1:
I forgot that this will leave the sheet with the filter on...use activesheet.showalldata for show all the rows and not only the filtered ones
Edit 2:
The tests
If rng_5xx_stop < Row.Row Then
rng_5xx_stop = Row.Row
End If
and
If rng_7xx_stop < Row.Row Then
rng_7xx_stop = Row.Row
End If
are not necessary, it's enough do rng_5xx_stop = Row.Row and rng_7xx_stop = Row.Row and save the two IF statements
You are grouping cells based on the first number of the cell values in column B (I am assuming that they can never be letters). If that is the case, then you can create an array of 0 to 9 and store your ranges in there. Then go through the range.areas in order to get the groupings you're looking for (as highlighted in your screenshot).
To do this, something like this is all you need. I commented code to try to explain it more:
Sub tgr()
Dim wsData As Worksheet
Dim rColB As Range
Dim BCell As Range
Dim aRanges(0 To 9) As Range
Dim SubGroup As Range
Dim lRangeNum As Long
Dim i As Long
'Change to your actual worksheet
Set wsData = ActiveWorkbook.ActiveSheet
'Change to your actual column range, this is based off the sample data
Set rColB = wsData.Range("B1", wsData.Cells(wsData.Rows.Count, "B").End(xlUp))
'Loop through the column range
For Each BCell In rColB.Cells
'Make sure the cell is populated and the starting character is numeric
If Len(BCell.Value) > 0 And IsNumeric(Left(BCell.Value, 1)) Then
'Get the starting digit
lRangeNum = Val(Left(BCell.Value, 1))
'Check if any ranges have been assigned to that array index location
'If not, start a range at that array index
'If so, combine the ranges with Union
Select Case (aRanges(lRangeNum) Is Nothing)
Case True: Set aRanges(lRangeNum) = BCell
Case Else: Set aRanges(lRangeNum) = Union(aRanges(lRangeNum), BCell)
End Select
End If
Next BCell
'You can use any method you want to access the ranges, this just loops
'through the array indices and displays the range areas of each
For i = 0 To 9
If Not aRanges(i) Is Nothing Then
For Each SubGroup In aRanges(i).Areas
'Do what you want with it here
'This just selects the subgroup so you can see it found the groups properly
SubGroup.Select
MsgBox SubGroup.Address
Next SubGroup
End If
Next i
End Sub
I see you've allready rewritten your code, but I'd like to offer how I would do it and would like to know your thoughts about it. Would this be inefficient? I guess it could be because you have to read the first character in cells 4 times for every increment, but not shure if that is a big problem.
Dim start_row As Long
Dim end_row As Long
start_row = 1
end_row = 0
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i - 1, 2) = "" Then
start_row = i
ElseIf Left(Cells(i - 1, 2), 1) <> Left(Cells(i, 2), 1) Then
start_row = i
End If
If Cells(i + 1, 2) = "" Then
end_row = i
ElseIf Left(Cells(i + 1, 2), 1) <> Left(Cells(i, 2), 1) Then
end_row = i
End If
If end_row <> 0 Then
Call copy_range(start_row, end_row)
end_row = 0
End If
Next i
Another approach that lets you only read the character once could be
Dim start_row As Long
Dim end_row As Long
Dim char_above As String
Dim this_char As String
start_row = 1
end_row = 1
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i, 2) = "" Then
end_row = i - 1
if i <>1 then Call copy_range(start_row, end_row,char_above)
start_row = i + 1
Else
this_char = Left(Cells(i, 2), 1)
If this_char <> char_above Then
end_row = i - 1
if i<> 1 then Call copy_range(start_row, end_row,char_above)
start_row = i
End If
char_above = this_char
End If
Next i
Let me know your thoughts.
I would like to check a certain column (W) for duplicates (number of occurrences is stored in another column (AZ)) and than delete all row this way:
Value is found two times in the column - delete only one row containing the value.
Value is found more times in the column - delete all the rows with the values.
My code works quite well but sometimes it doesn't delete all the duplicates as it should do. Any idea for improvement?
EDIT: The updated code works really good except that it always misses one duplicate and leaves it not deleted.
fin = ws.UsedRange.Rows.count
For i = 2 To fin
ws.Range("AZ" & i).value = Application.WorksheetFunction.CountIf(ws.Range("W2:W" & fin), ws.Range("W" & i))
Next i
For j = fin To 2 Step -1
If ws.Range("AZ" & j).value > 2 Then
ws.Range("AZ" & j).EntireRow.Delete
fin = ws.UsedRange.Rows.count
ElseIf ws.Range("AZ" & j).value = 2 Then
Set rng = Range("W:W").Find(Range("W" & j).value, , xlValues, xlWhole, , xlNext)
rngRow = rng.Row
If rngRow <> j Then
ws.Range("AZ" & rngRow) = "1"
ws.Range("AZ" & j).EntireRow.Delete
fin = ws.UsedRange.Rows.count
Else
MsgBox "Error at row " & rngRow
End If
End If
Next j
If speed is an issue, here is a method that should be faster, as it creates a collection of rows to be deleted, then deletes them. Since everything, except for the actual row deletion, is done in VBA, there are far fewer calls back and forth to the worksheet.
The routine could be sped up as noted in the inline comments.
If it is still too slow, depending on the size of the worksheet, it might be feasible to read the entire worksheet into a VBA Array; test for duplicates; write back the results to a new array and write that out to the worksheet. (If your worksheet is too large, this method might run out of memory, though).
In any event, we need both a Class Module which YOU must rename cPhrases, as well as a Regular Module
Class Module
Option Explicit
Private pPhrase As String
Private pCount As Long
Private pRowNums As Collection
Public Property Get Phrase() As String
Phrase = pPhrase
End Property
Public Property Let Phrase(Value As String)
pPhrase = Value
End Property
Public Property Get Count() As Long
Count = pCount
End Property
Public Property Let Count(Value As Long)
pCount = Value
End Property
Public Property Get RowNums() As Collection
Set RowNums = pRowNums
End Property
Public Function ADDRowNum(Value As Long)
pRowNums.Add Value
End Function
Private Sub Class_Initialize()
Set pRowNums = New Collection
End Sub
Regular Module
Option Explicit
Sub RemoveDuplicateRows()
Dim wsSrc As Worksheet
Dim vSrc As Variant
Dim CP As cPhrases, colP As Collection, colRowNums As Collection
Dim I As Long, K As Long
Dim R As Range
'Data worksheet
Set wsSrc = Worksheets("sheet1")
'Read original data into VBA array
With wsSrc
vSrc = .Range(.Cells(1, "W"), .Cells(.Rows.Count, "W").End(xlUp))
End With
'Collect list of items, counts and row numbers to delete
'Collection object will --> error when trying to add
' duplicate key. Use that error to increment the count
Set colP = New Collection
On Error Resume Next
For I = 2 To UBound(vSrc, 1)
Set CP = New cPhrases
With CP
.Phrase = vSrc(I, 1)
.Count = 1
.ADDRowNum I
colP.Add CP, CStr(.Phrase)
Select Case Err.Number
Case 457 'duplicate
With colP(CStr(.Phrase))
.Count = .Count + 1
.ADDRowNum I
End With
Err.Clear
Case Is <> 0 'some other error. Stop to debug
Debug.Print "Error: " & Err.Number, Err.Description
Stop
End Select
End With
Next I
On Error GoTo 0
'Rows to be deleted
Set colRowNums = New Collection
For I = 1 To colP.Count
With colP(I)
Select Case .Count
Case 2
colRowNums.Add .RowNums(2)
Case Is > 2
For K = 1 To .RowNums.Count
colRowNums.Add .RowNums(K)
Next K
End Select
End With
Next I
'Revers Sort the collection of Row Numbers
'For speed, if necessary, could use
' faster sort routine
RevCollBubbleSort colRowNums
'Delete Rows
'For speed, could create Unions of up to 30 rows at a time
Application.ScreenUpdating = False
With wsSrc
For I = 1 To colRowNums.Count
.Rows(colRowNums(I)).Delete
Next I
End With
Application.ScreenUpdating = True
End Sub
'Could use faster sort routine if necessary
Sub RevCollBubbleSort(TempCol As Collection)
Dim I As Long
Dim NoExchanges As Boolean
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
For I = 1 To TempCol.Count - 1
' If the element is less than the element
' following it, exchange the two elements.
If TempCol(I) < TempCol(I + 1) Then
NoExchanges = False
TempCol.Add TempCol(I), after:=I + 1
TempCol.Remove I
End If
Next I
Loop While Not (NoExchanges)
End Sub
no need to use that inefficient second loop in the second section, just use a live count like so
fin = ws.UsedRange.Rows.count
For i = 2 To fin
ws.Range("AZ" & i).value = Application.WorksheetFunction.CountIf(ws.Range("W2:W" & fin), ws.Range("W" & i))
Next i
For j = fin To 2 Step -1
If ws.Range("AZ" & j).value > 2 OR Application.WorksheetFunction.CountIf(ws.Range("W2:W" & fin), ws.Range("W" & j)) = 2 Then
ws.Range("AZ" & j).EntireRow.Delete
End If
Next j
While your logic is basically sound, the method is not the most efficient. The AutoFilter Method can quickly remove all counts greater than 2 and the Range.RemoveDuplicates¹ method cansubsequently make quick work of removing one of the rows that still contain duplicate values in column W.
Dim r As Long, c As Long
With ws
If .AutoFilterMode Then .AutoFilterMode = False
r = .Cells.SpecialCells(xlLastCell).Row
c = Application.Max(52, .Cells.SpecialCells(xlLastCell).Column)
With .Range("A1", .Cells(r, c)) '.UsedRange
With .Columns(52)
If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1) = "count"
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
.Cells.FormulaR1C1 = "=COUNTIF(C[-29], RC[-29])"
.Cells = .Cells.Value
End With
.AutoFilter field:=1, Criteria1:=">2"
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
End With
.AutoFilter
End With
.RemoveDuplicates Columns:=23, Header:=xlYes
End With
End With
When you rewrite the count values in column AZ, you are likely going to rewrite 3 counts to 2, etc.
¹ The Range.RemoveDuplicates method removes duplicate rows from the bottom up.