PDA

View Full Version : Solved: Deleting group of rows if string pattern doesnt match



Ashes.cfg
09-26-2007, 07:23 AM
Hey

I have the following
in column A i have some labels and in column B i have its properties listed one below the other in diff cells(b1,b2,b3, etc). now wat i want to do is delete the entire label and its properties if any of those properties dont match a particular string.
for eg
there are some labels whose properties end with abc_xyz only and there are some labels whose properties end with abc_xyz and also fgh_utf...so basically i wanna retain only those labels having properties ending with abc_xyz and not the labels have both as properties..

please help me in this one.

Bob Phillips
09-26-2007, 07:33 AM
Sample workbook with a before and after please.

malik641
09-26-2007, 08:42 AM
Hi, Welcome to VBAX

As XLD said, a workbook would help a lot. Given what you've described, I came up with the following (workbook attached too):
Option Explicit

Public Sub DeleteSpecialFilteredData()
' This procedure will use Advanced Filtering to
' find 2 specific values in one column (col B)
' that have an equal value in another column (col A)

' NOTE: For this workbook, Col A = "Labels" and Col B = "Properties"

' The idea behind this method is to:
' A: Filter the specific 2 values in "Properties" column and copy
' the data to another range (use Unique Records Only)
' B: Use that list and filter again to find if "Labels" column has more
' than one entry in it (again Unique Records Only...just to be sure)
' and copy it to another range. This new list will be the "Labels"
' that we want to delete.
' C: Use that last list and filter the ORIGINAL list using the "Labels" column
' to filter out the labels we want to delete.
' D: Delete the visible rows (after row 1)
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim wsFiltering As Excel.Worksheet
Dim wsOriginal As Excel.Worksheet
Dim rngOriginal As Excel.Range
Dim rngFilteredData1 As Excel.Range
Dim rngFilterCriteriaFinal As Excel.Range

Set wsFiltering = ThisWorkbook.Worksheets.Add
Set wsOriginal = ThisWorkbook.Worksheets("Sheet1")
Set rngOriginal = wsOriginal.Range("A1", wsOriginal.Cells(Rows.Count, "B").End(xlUp).Address)

' First Sort data by "Labels" column (this is needed for a filter later on)
With wsOriginal.Sort
.SortFields.Clear
.SortFields.Add Key:=wsOriginal.Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rngOriginal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Clear any highlighted cells (from a previous run)
wsOriginal.Range("A2", wsOriginal.Cells(Rows.Count, Columns.Count)).ClearFormats

' Set filter criteria to find specific properties
With wsFiltering
.Range("A1").Value = "Properties"
.Range("A2").Value = "=""=abc_xyz"""
.Range("B1").Value = "Properties"
.Range("B3").Value = "=""=fgh_utf"""
End With

' Filter
rngOriginal.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsFiltering.Range("A1:B3"), _
CopyToRange:=wsFiltering.Range("C1"), _
Unique:=True

' Set filtered range
Set rngFilteredData1 = wsFiltering.Range("C1", Cells(Rows.Count, "D").End(xlUp))

' Set filter criteria to find 2 matching labels
wsFiltering.Range("E2").Value = "=C1=C2"

' Filter
rngFilteredData1.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsFiltering.Range("E1:E2"), _
CopyToRange:=wsFiltering.Range("F1"), _
Unique:=True

' Set filtered range 2
Set rngFilterCriteriaFinal = wsFiltering.Range("F1", wsFiltering.Cells(Rows.Count, "F").End(xlUp))

' Filter ORIGINAL data and delete unwanted rows
rngOriginal.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=rngFilterCriteriaFinal, _
Unique:=True

' NOTE: FOR NOW, I will only HIGHLIGHT the rows to be deleted
' COMMENT THE FOLLOWING HIGHLIGHT METHOD AND UNCOMMENT THE DELETE METHOD TO DELETE THE ROWS
wsOriginal.Range(wsOriginal.Cells(2, "A"), wsOriginal.Cells(Rows.Count, "A").End(xlUp)) _
.SpecialCells(xlCellTypeVisible).EntireRow.Interior.Color = vbYellow

' wsOriginal.Range(wsOriginal.Cells(2, "A"), wsOriginal.Cells(Rows.Count, "A").End(xlUp)) _
' .SpecialCells(xlCellTypeVisible).EntireRow.Delete

wsOriginal.ShowAllData

' Delete created sheet (UNCOMMENT IT...I left it there so you can see the results of
' the preceeding code)

'wsFiltering.Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
It's a little confusing...but it works as far as I can see.
Hope this helps.

Ashes.cfg
09-26-2007, 09:50 AM
I ve attached the b4 and after sheets
here abc stands for locations which end with gen_icon_id.h

and xyz and fgh are not ending while tht string.

So basically my end result should be B and D in new sheet2 as they contains the files ending only with gen_icon_id.h (i.e abc in this case)shown in the after sheet.(have made a typo in after sheet... it should be B and not A)

thanks for prompt reply!
Ashwin

Bob Phillips
09-26-2007, 09:58 AM
I make it A, B, C and D



Public Sub ProcessData()
Dim i As Long
Dim iLastRow As Long
Dim iRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iRow = 1
.Range("A1").Copy Worksheets("Sheet2").Range("A1")
For i = 1 To iLastRow
If .Cells(i, "B").Value = "abc" Then
If IsError(Application.Match(.Cells(i, "A").Value, Worksheets("Sheet2").Columns(1), 0)) Then
iRow = iRow + 1
.Cells(i, "A").Copy Worksheets("Sheet2").Cells(iRow, "A")
End If
End If
Next i

End With

End Sub

Ashes.cfg
09-26-2007, 10:02 AM
I am totally new to VBA. the thing is abc is not a value..abc =gen_icon_id.h ..which is the end of the string! and i need to compare this gen_icon_id.h with every cell in column b!

and i want only those labels which contain gen_icon_id.h(abc) and not the ones which have xyz in it.. hence the result should be only B and D

trust me i was able to get the exact opposite of ths.

Bob Phillips
09-26-2007, 10:05 AM
Okay,



Public Sub ProcessData()
Const TEST_STRING As String = "gen_icon_id.h"
Dim i As Long
Dim iLastRow As Long
Dim iRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
iRow = 1
.Range("A1").Copy Worksheets("Sheet2").Range("A1")
For i = 1 To iLastRow
If Right(.Cells(i, "B").Value, Len(TEST_STRING)) = TEST_STRING Then
If IsError(Application.Match(.Cells(i, "A").Value, Worksheets("Sheet2").Columns(1), 0)) Then
iRow = iRow + 1
.Cells(i, "A").Copy Worksheets("Sheet2").Cells(iRow, "A")
End If
End If
Next i

End With

End Sub

Ashes.cfg
09-26-2007, 10:11 AM
Sorry Xld the last code doesnt retrieve anything..neither a b c nor d...it just says label in sheet 2!(corrrection it does give A B C D..mistake accepted)..But i still need only B and D :(

Bob Phillips
09-26-2007, 10:20 AM
I changed it to look for the real end string.

Ashes.cfg
09-26-2007, 10:26 AM
But still it doesnt solve the issue of only copyin B and D label!

Bob Phillips
09-26-2007, 10:55 AM
Then you will have to give us proper rules. All 4 had abc in vcolumn B, and your rule was copy it if abc in column B.

Ashes.cfg
09-26-2007, 11:01 AM
ok here is the deal.... all the four labels have gen_icon_id.h in columnB..and the rule is to copy the labels IF AND ONLY IF they contain gen_icon_id.h and nuthing other than that. Since Labels B and D contain only and only gen_icon_id.h (i.e abc in our example) only they should be the ones to be copied to a new worksheet..

I hope you are understanding me :(

Ashes.cfg
09-27-2007, 04:45 AM
Thanks XLD close this topic.. well i mixed your code with mine..and voila getting it right now..

thanks for the help!
Ashwin Samant