'
' Delete All rows where the column content is equal to the current Cell Macro
' It assumes you are already on the Events sheet!
'
' Macro created 13-2-2006 by Bob Becker Hof (HP)
' Tested with Excel 2003 and EVE 2.30 xls output format
' Changed Row and Column variables from Integer to Long to avoid Overflow if more then 32767 rows
' Disable screen updates during the removal process of the matching rows and enable it once we are done
' Show progress while being busy by changing the window headers
' Fixed a bug where we did not get back to the first cell above the cell we deleted this change additionally speeds up significantly
' Moved the real code to a function which is called by the original (sub) macro. The sub will call the function
' 	with a parameter "Interactive". The function itself does nothing with it but. It has been splitted to make it conform the other 
'		macros. Nothing more.
' Fixed a but where the place we are back on the sheet is not a hidden row
' Fixed the lasrow determination
' If the length of the file is huge the progress indicator at the top get an overflow (>200 characters) and get into the debugger.
'   We now check the length of the variable and if it exceeds 200 we take the last 197 characters and put three dots at the start.
'

Sub DeleteThisAndSimilarRowsLikeCurrentCell()
		Function_DeleteThisAndSimilarRowsLikeCurrentCell("Interactive")
End Sub

Function Function_DeleteThisAndSimilarRowsLikeCurrentCell(mode)

Dim crow As Long
Dim ccol As Long
Dim lasrow As Long
Dim lascol As Long
Dim trow As Long
Dim tcol As Long
Dim frow As Long
Dim findstring As String
Dim curstring As String
Dim stepsize As Double
Dim steprows As Integer
Dim stepperc As String
Dim currentcaption As String
Dim hidden_rows_behind_lasrow As Long

    crow = ActiveCell.Row
    ccol = ActiveCell.Column
    findstring = ActiveCell.Value
    lasrow = ActiveCell.SpecialCells(xlLastCell).Row
    lascol = ActiveCell.SpecialCells(xlLastCell).Column
    tcol = ccol
    trow = lasrow

'
' By default the xlLastCell.row funtion returns the last visible row
' But there might be more rows below it which are hidden so loop down until we hit a row which is NOT hidden
' Lets assume that 650000 is the maximum row number possible...
'
''    Debug.Print "Current Lasrow: " & Str(lasrow)
    For hidden_rows_behind_lasrow = lasrow To 650000 Step 1
        If Not (Range(Cells(hidden_rows_behind_lasrow + 1, 1).Address).EntireRow.Hidden) Then
            lasrow = hidden_rows_behind_lasrow
''            Debug.Print "New Lasrow    : " & Str(lasrow)
            Exit For
        End If
    Next

' Temporarily stop screen updates to speed up the process
    Application.ScreenUpdating = False
    currentcaption = ActiveWorkbook.Windows(1).Caption    ' Save current Window Caption

'
' Loop from the last row for this column and find all matching cells within this column and hide them
'

' We would like to see how we are progressing even though we disable the screen updates...
    stepsize = (lasrow - 1) / 10                           ' We display info each 10th time
    steprows = 0

    For trow = lasrow To 2 Step -1
        
        steprows = steprows + 1
'
' Do we have to show where we are?
'
        If (steprows > stepsize) Then
            stepperc = currentcaption & " ==> DeleteThisAndSimilarRowsLikeCurrentCell progress... " & Int((lasrow - trow) / lasrow * 100) & " %"
            if len(stepperc) > 200 Then
            	stepperc = "..." & right(stepperc,197)
            End If
            Application.ScreenUpdating = True
            ActiveWorkbook.Windows(1).Caption = stepperc
            Application.ScreenUpdating = False
            steprows = 0                                    ' Count our steps again for our next intermediate result
        End If
        
        Cells(trow, tcol).Select
        curstring = ActiveCell.Value
        If curstring = findstring Then
            Rows(trow).Select
            Selection.Delete Shift:=xlUp
                        
' We removed one row above our starting row so we have to substract one from our starting row
            If trow <= crow Then
                crow = crow - 1
            End If
        
        End If
    Next

' Enable original windows caption again
    ActiveWorkbook.Windows(1).Caption = currentcaption
    
'
' If the current row is hidden we have to go up until we have one that is visible
'
    Cells(1, ccol).Select
		For trow = crow To 1 step -1
    		If Not Range(Cells(trow, ccol).Address).EntireRow.Hidden Then
        		Cells(trow, ccol).Select
            trow = 1
    		End If
    Next

' Enable screen updates again
    Application.ScreenUpdating = True

'
' Reset the last Cell
'
    ActiveSheet.UsedRange

End Function