Sub newB() Dim rgnFilter As Range, rgnArea As Range, rgnRow As Range Dim i As Long, lastRow As Long Dim toDelete As Boolean With Sheet1 'If data is unfiltered then exit sub' If .AutoFilterMode = False Then MsgBox "Please filter the data first.", vbInformation Exit Sub End If 'Get lastRow data' lastRow = .Range("C" & Rows.Count).End(xlUp).Row 'Set column C filtered data as rgn' Set rgnFilter = .Range("C7:C" & lastRow).SpecialCells(xlCellTypeVisible) toDelete = False 'loop each filtered area' For Each rgnArea In rgnFilter.Areas 'If filtered area have rows>1 then proceed' If rgnArea.Rows.Count > 1 Then 'Loop each cell in each filtered area' For Each rgnRow In rgnArea 'If toDelete = false then skip else delete in cell B row' If toDelete = False Then toDelete = True Else .Range("B" & rgnRow.Row).Value = Empty toDelete = False End If Next rgnRow End If Next rgnArea 'Unfilter sheet' .AutoFilterMode = False End With End Sub
Preview:
downloadDownload PNG
downloadDownload JPEG
downloadDownload SVG
Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!
Click to optimize width for Twitter