Find column and delete rows below....

[BenGee]

Hi - I have multiple worksheets and in each, contain a unique header across varying columns. I also have a range K2:K31 on a worksheet named "qMatrix" which contain specific headers that will be in one or more of these worksheets. The headers in "qMatrix", if they exist in a column header on one of the other worksheets, will be unique - i.e. There will never be more than one match in a column header to the strings held in K2:K31.

What I'm trying to do is loop through each worksheet, find if one of the strings in K2:K31 are found in the column header and if true, get that column number. I'll then use the column number to loop through cells below to delete rows based on my condition.

Here's what I've got so far;

Dim rng1 As Range
Dim c As Range
Dim lastRow As Long, i As Long
Dim ws As Worksheet

lRange = Sheets("qMatrix").Range("K2:K31").Value

For Each ws In Worksheets
    Set rng1 = ActiveSheet.UsedRange.Find(lRange, , xlValues, xlWhole)
    If Not rng1 Is Nothing Then
        lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        For i = lastRow To 2 Step -1
            If Application.Count(ActiveSheet.Range(rng1.Column & i).Resize(, 3)) < 3 Then Rows(i).Delete
        Next i
    End If
Next

It does nothing though. Doesn't execute anything nor does it present any errors.

Any help would be appreciated.

 

[BenGee]

Thanks Alex, the string length was the final issue in my data! I've made some tweaks and I'm now able to achieve the expected results on each worksheet.

Details of what I've done - I need the value in K to continue in it's full length for other users. So I've introduced a helper column ("O2:O31") with a MID formula that trims the strings in K to the first 100 characters. For example, in O2 the formula is "=MID(K2, 1, 100)". A LEFT formula also works

I've then applied the same logic to this line from your proposed solution;

            If Mid(lRange(j, 1), 1, 100) <> "" Then

Alex, appreciate you persevering and supporting me with this. Very grateful.



Full code here;

Dim rng1 As Range
Dim c As Range
Dim lastRow As Long, i As Long, j As Long
Dim ws As Worksheet

Dim wsqMatrix As Worksheet
Dim lRange As Variant

Set wsqMatrix = Worksheets("qMatrix")
lRange = wsqMatrix.Range("O2:O31").Value

For Each ws In Worksheets
    If ws.Name <> wsqMatrix.Name Then
        For j = 1 To UBound(lRange)
            If Mid(lRange(j, 1), 1, 100) <> "" Then
                Set rng1 = ws.Rows(1).Find(lRange(j, 1), , xlValues, xlPart)
                If Not rng1 Is Nothing Then
                    With ws
                        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
                        For i = lastRow To 2 Step -1
                            If Application.Count(.Cells(i, rng1.Column).Resize(, 3)) < 3 Then .Rows(i).Delete
                        Next i
                    End With
                    Exit For
                End If
            End If
        Next j
    End If
Next

 

[Alex Blakenburg]

Appreciate the update. Glad I could help.