Option Explicit
Sub RepeatSlayer()
'by time*treat, Jan 24, 2017'
'Looks through a rectangular grid of numbers and'
'removes rows where a number repeats in the same set'
'or groups of digits have repeated in prior row/sets'
'This beta version works on the active sheet and is not yet completely idiot-proof. :^)'
'It doesn't handle merged cells, but checks for non-numeric text'
'All numbers SHOULD be between values set by **Min__num** and **Max__Num**, inclusive'
'Written/tested in Excel 2003'
'** Caution 1 **: Output is sensitive to set listing order and operation order'
Dim Beginning__Row As Long, Beginning__Col As Long
Dim Ending__Row As Long, Ending__Col As Long
Dim Min__num As Long, Max__Num As Long, Master__set() As Long
Dim Master__Row As Long, Slave__Row As Long
Dim Master__Col As Long, Slave__Col As Long, Output__Row As Long
Dim ValRepeat__Flag As Boolean
Dim MaxGroupletSize As Long, CurrentGroupletSize As Long
Output__Row = 0: MaxGroupletSize = 3
Beginning__Row = 1: Beginning__Col = 1
Ending__Row = 400: Ending__Col = 6
Min__num = 1: Max__Num = 50
'Slay Internal Repeats'
For Master__Row = Beginning__Row To Ending__Row
If Cells(Master__Row, Beginning__Col).Value <> "" Then
ReDim Master__set(Min__num To Max__Num): ValRepeat__Flag = False
For Master__Col = Beginning__Col To Ending__Col
If IsNumeric(Cells(Master__Row, Master__Col).Value) Then
If Cells(Master__Row, Master__Col).Value >= Min__num And _
Cells(Master__Row, Master__Col).Value <= Max__Num Then
Master__set(Cells(Master__Row, Master__Col).Value) = _
Master__set(Cells(Master__Row, Master__Col).Value) + 1
End If 'Min/Max'
End If 'IsNumeric'
If Master__set(Cells(Master__Row, Master__Col).Value) > 1 Then
ValRepeat__Flag = True
Exit For 'Master__col'
End If 'Master__set() > 1'
Next Master__Col
If ValRepeat__Flag = False Then
Output__Row = Output__Row + 1
If Output__Row = Master__Row Then
'do nothing'
Else
'Shift Values' Location'
For Master__Col = Beginning__Col To Ending__Col
Cells(Output__Row, Master__Col).Value = _
Cells(Master__Row, Master__Col).Value
Cells(Master__Row, Master__Col).Value = ""
Next Master__Col
End If
ElseIf ValRepeat__Flag = True Then
'Erase Row'
For Master__Col = Beginning__Col To Ending__Col
Cells(Master__Row, Master__Col).Value = ""
Next Master__Col
End If
End If 'Cells(Master__Row, Beginning__Col).Value <> ""'
Next Master__Row
'Slay Outsized Grouplet Repeats'
Ending__Row = Output__Row '***'
For Master__Row = Beginning__Row To Ending__Row - 1
Output__Row = Master__Row
If Cells(Master__Row, Beginning__Col).Value <> "" Then
ReDim Master__set(Min__num To Max__Num)
For Master__Col = Beginning__Col To Ending__Col
If IsNumeric(Cells(Master__Row, Master__Col).Value) Then
If Cells(Master__Row, Master__Col).Value >= Min__num And _
Cells(Master__Row, Master__Col).Value <= Max__Num Then
Master__set(Cells(Master__Row, Master__Col).Value) = _
Master__set(Cells(Master__Row, Master__Col).Value) + 1
End If 'Min/Max'
End If 'IsNumeric'
Next Master__Col
For Slave__Row = Master__Row + 1 To Ending__Row
If Cells(Slave__Row, Beginning__Col).Value <> "" Then
CurrentGroupletSize = 0
For Slave__Col = Beginning__Col To Ending__Col
If IsNumeric(Cells(Slave__Row, Slave__Col).Value) Then
If Cells(Slave__Row, Slave__Col).Value >= Min__num And _
Cells(Slave__Row, Slave__Col).Value <= Max__Num Then
If Master__set(Cells(Slave__Row, Slave__Col).Value) = 1 Then _
CurrentGroupletSize = CurrentGroupletSize + 1
End If 'Min/Max'
End If 'IsNumeric'
Next Slave__Col
If CurrentGroupletSize <= MaxGroupletSize Then
Output__Row = Output__Row + 1
If Output__Row = Slave__Row Then
'do nothing'
Else
'Shift Values' Location'
For Master__Col = Beginning__Col To Ending__Col
Cells(Output__Row, Master__Col).Value = _
Cells(Slave__Row, Master__Col).Value
Cells(Slave__Row, Master__Col).Value = ""
Next Master__Col
End If
ElseIf CurrentGroupletSize > MaxGroupletSize Then
'Erase Row'
For Master__Col = Beginning__Col To Ending__Col
Cells(Slave__Row, Master__Col).Value = ""
Next Master__Col
End If
End If 'Cells(Slave__Row, Beginning__Col).Value <> ""'
Next Slave__Row
End If 'Cells(Master__Row, Beginning__Col).Value <> ""'
Next Master__Row
End
End Sub
