# Calc how to find multiple cells that repeat

Ok so I have a random list of words, (each word takes up a cell) inside columns A-P and rows 1-100,
the words do repeat.

So my job is to find any three words (lets call any three words that do repeat a set, set can be in any order) that repeat in at least 3 rows.

And I want a chart listing each set repeated, next to each set how many rows found with that set.

I would also like to highlight each set in different colors.

Well, here is half of the solution to your problem as you described it:

``````Sub findAndColor
Dim aSets
aSets = findMultipleCellsThatRepeat("Demo", "A1:P100")
Rem Now the aSets array contains information about all found sets. You can print, draw charts and more
End Sub

Function findMultipleCellsThatRepeat(sSheetName As String, sRangeName As String) As Variant
Rem The function will collect data about duplicate values ​​and paint them on the sheet
Const MIN_COUNT = 3
Dim oSheet As Variant
Dim oRange As Variant
Dim oData As Variant
Dim i As Long, j As Long
Dim aRes As Variant
Rem Get data from range to array:
oSheet = ThisComponent.getSheets().getByName(sSheetName)
oRange = oSheet.getCellRangeByName(sRangeName)
oData = oRange.getDataArray()
Rem Count repetitions by columns:
For i = LBound(oData(0)) To UBound(oData(0))
oData(0)(i)= Array(oData(0)(i), 1)
For j = LBound(oData)+1 To UBound(oData)
If oData(j)(i) = oData(j-1)(i)(0) Then
oData(j)(i) = Array(oData(j)(i), oData(j-1)(i)(1) + 1)
Else
oData(j)(i) = Array(oData(j)(i), 1)
EndIf
Next j
Next i
Rem Collect all sets with at least MIN_COUNT (= 3) items
aRes = Array()
For i = LBound(oData(0)) To UBound(oData(0))
j = UBound(oData)
While j > LBound(oData)
If oData(j)(i)(1) >= MIN_COUNT Then
Call AppendToArray(aRes, Array(oData(j)(i)(0), oData(j)(i)(1), i, j-oData(j)(i)(1)+1, j))
j = j-oData(j)(i)(1)
Else
j = j-1
EndIf
Wend
Next i
Rem Paint the sets randomly:
For i = LBound(aRes) To UBound(aRes)
oRange.getCellRangeByPosition(aRes(i)(2), aRes(i)(3), aRes(i)(2), aRes(i)(4)).CellStyle = _
crtStylesIfNeed(RandomColorCode(), aRes(i)(0) & "_" & aRes(i)(1)  & "_" )
Next i
Rem Return the list of sets for further processing (including creating a diagram)
findMultipleCellsThatRepeat = aRes
End Function

Sub AppendToArray(oData As Variant, ByVal x As Variant)
Rem Utility procedure - adds an element to the end of an existing array
Dim iLB As Long, iUB As Long
iLB = LBound(oData, 1)
iUB = UBound(oData, 1) + 1
ReDim Preserve oData(iLB To iUB)
oData(iUB) = x
End Sub

Function RandomColorCode()
Const HEX_LETTER = "0123456789ABCDEF"
RandomColorCode = "#" & _
Mid(HEX_LETTER, Int((16 * Rnd) +1),1) & _
Mid(HEX_LETTER, Int((16 * Rnd) +1),1) & _
Mid(HEX_LETTER, Int((16 * Rnd) +1),1) & _
Mid(HEX_LETTER, Int((16 * Rnd) +1),1) & _
Mid(HEX_LETTER, Int((16 * Rnd) +1),1) & _
Mid(HEX_LETTER, Int((16 * Rnd) +1),1)
End Function
``````

The crtStylesIfNeed function code is there