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.

 

[Alex Blakenburg]

Try this on a copy of your workbook.

Sub FindDelete()

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("K2:K31").Value

For Each ws In Worksheets
    If ws.Name <> wsqMatrix.Name Then
        For j = 1 To UBound(lRange)
            If lRange(j, 1) <> "" Then
                Set rng1 = ws.UsedRange.Find(lRange(j, 1), , xlValues, xlWhole)
                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

End Sub

 

[BenGee]

Try this on a copy of your workbook.

Sub FindDelete()

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("K2:K31").Value

For Each ws In Worksheets
    If ws.Name <> wsqMatrix.Name Then
        For j = 1 To UBound(lRange)
            If lRange(j, 1) <> "" Then
                Set rng1 = ws.UsedRange.Find(lRange(j, 1), , xlValues, xlWhole)
                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

End Sub

Thanks Alex.

So the result is it deletes all contents on all worksheets, which is more than what mine was doing!! So appreciate your guidance towards a solution.

I'm looking to see how I can tweak the solution you've kindly offered me to meet my need, but there's just one bit I'm struggling to understand and I'm hoping you can help me again please.

This bit;

        For j = 1 To UBound(lRange)
            If lRange(j, 1) <> "" Then

Thanks in advance

 

[Alex Blakenburg]

Which piece are you not sure of ?

 For j = 1 To UBound(lRange)

You have loaded K2:K31 into an array called lRange.
You now want to search for every value held in that array.
To do that you need to loop through every element ie lRange(j,1)

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

If there was an empty cell in the range K2:K31 it caused unwanted behaviour, since it found the first empty cell in the first row of the worksheet being checked.
The If statement causes it to skip the actions and move on to the next item to find.

 

[BenGee]

Thanks Alex - that's helpful thank you.

So after some tweaking and testing I've adjusted this line;

Set rng1 = ws.UsedRange.Find(lRange(j, 1), , xlValues, xlWhole)

To;

Set rng1 = ws.Rows(1).Find(lRange, , xlValues, xlWhole)

This seems to achieve exactly what I'm after but only on the first worksheet. Which is odd as previously it seemed to loop through each worksheet and this remains unchanged. Any idea what I'm overlooking in order to get it to loop through the remaining worksheets in the same workbook please?

Here's everything with the adjustment;

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("K2:K31").Value

For Each ws In Worksheets
    If ws.Name <> wsqMatrix.Name Then
        For j = 1 To UBound(lRange)
            If lRange(j, 1) <> "" Then
                Set rng1 = ws.Rows(1).Find(lRange, , xlValues, xlWhole)
                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

Thanks so far for all your help!

 

[Alex Blakenburg]

re:

              Set rng1 = ws.Rows(1).Find(lRange, , xlValues, xlWhole)

1) Rows(1)
Is fine as long as you are sure the heading row on each sheet is row 1

2)

Find(lRange,

Will not work, lRange is an array of values from K2:K31
You need to loop through the array which is what the lRange(j, 1) is doing.

 

[BenGee]

Point 2 makes sense but I get a type mismatch when reverting back to how you originally expressed it.

 

[Alex Blakenburg]

What line is highlighted when it errors out ?
If it is on any line containing lRange(j, 1) in the immediate window (ctrl+g if not visible) put in
? lRange(j, 1) then enter
? j then enter
? ws.name then enter
What value did each return ?

 

[BenGee]

Sorry, the type mismatch is on this line;

Set rng1 = ws.Rows(1).Find(lRange(j, 1), , xlValues, xlWhole)

And the results I get on the immediate window are;

? lRange(j, 1)
q5 : Your attitudes to the overall - On a scale of 1 to 7, where 1 is 'Failed completely' and 7 is 'Succeeded completely', to what degree do you think the Consulting advice service effectively addressed your original need?

? j
 15

?ws.Name
GroupCX_Graphs

 

[Alex Blakenburg]

Thanks for giving such a complete response.
"Column header" generally implies a short description, I was not expecting somethin that long.
The find command will generate exactly the error you are getting if the search string is 256 characters or more.
This is bit confusing since your string as pasted in above is only 222 characters long.

If you use =LEN(Cell_containing_Q5) on both the value in K and wherever the heading is used, does it give you the same length in both place ?
Also what is that length ?
If you are getting something longer than 222 does using=LEN(TRIM(Cell_containing_Q5)) give you 222.
If it was over 255 one solution is to truncate it below that number and switch from xlWhole to xlPart in the find. Let's see what you come back with on my questions.