Assist with possible VBA macro

[Castor]

Hey all,

Tried the search function, did not turn up any results - I am wanting to see if a macro is possible that will delete certain rows - Rows that do not contain values that are adjacent to each other. For example:

Col 1	Col 2	Col 3	Col 4	Col 5	Col 6	Col 7	Col 8
AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA
BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB
CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC
CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC
CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC
DDDD	DDDD	DDDD	DDDD	DDDD	DDDD	DDDD	DDDD
EE	EE	EE	EE	EE	EE	EE	EE
FFF	FFF	FFF	FFF	FFF	FFF	FFF	FFF
G	G	G	G	G	G	G	G
G	G	G	G	G	G	G	G
JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ
KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK
LLLL	LLLL	LLLL	LLLL	LLLL	LLLL	LLLL	LLLL

I am hoping for a macro that can delete the rows that are blank as well as the rows with values that are alone. ie: delete the blanks rows as well as the rows with A, B, D, E, F, J, K and L, and keep the rows with C and G since they are 3 and 2 rows adjacent to each other with values contained within.

Any assist is greatly appreciated! Please let me know if this is not clear.

Thank you

 

[duggie33]

If your data is in a Table, you could filter for the blank rows, select them, and delete them. For the duplicate rows or adjacent rows with data, you could add a helper column to test if it meets your criteria and then filter on that column to get the rows to be deleted. The order of operations is likely important so test it before deleting your data. Below is an example of the "helper column".

Book1.xlsx
	A	B	C	D	E	F	G	H	I
1	Col 1	Col 2	Col 3	Col 4	Col 5	Col 6	Col 7	Col 8	Col 9
2	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	AAAAAAA	FALSE
3	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	BBBBB	FALSE
4	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	TRUE
5	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	TRUE
6	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	CCCCCCC	TRUE
7	DDDD	DDDD	DDDD	DDDD	DDDD	DDDD	DDDD	DDDD	FALSE
8	EE	EE	EE	EE	EE	EE	EE	EE	FALSE
9	FFF	FFF	FFF	FFF	FFF	FFF	FFF	FFF	FALSE
10	G	G	G	G	G	G	G	G	TRUE
11	G	G	G	G	G	G	G	G	TRUE
12	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	JJJJ	FALSE
13	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	KKKKK	FALSE
14	LLLL	LLLL	LLLL	LLLL	LLLL	LLLL	LLLL	LLLL	FALSE
Sheet6

Cell Formulas
Range	Formula
I2:I14	I2	=OR([@[Col 8]]=H1,[@[Col 8]]=H3)

Hope that helps,

Doug

 

[mumps]

Try:

Sub DeleteRows()
    Application.ScreenUpdating = False
    Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
    Dim v As Variant, i As Long, rng As Range, lCol As Long
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    v = Range("A1", Range("A" & Rows.Count).End(xlUp))
    For i = LBound(v) To UBound(v)
        If WorksheetFunction.CountIf(Range("A:A"), v(i, 1)) = 1 Then
            If rng Is Nothing Then Set rng = Range("A" & i).Resize(, lCol) Else Set rng = Union(rng, Range("A" & i).Resize(, lCol))
        End If
    Next i
    rng.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub