Using 'Like; to meet multiple conditions

[almodne]

Hi, over past day or so i've built a quite a like VBA script with the help of the recorder, google and searching this board. However i've now hit a wall.

The script imports an ASCII file, sorts it then analyses the data, couting totals etc. The difficulty comes in the fact the the ASCII file contents can be very varied. So the Macro has to check whether certain things are there then copies them to another sheet.

The problem I'm having is I'm using 'like' function to search as it doesn't seem to crash the script if it doesn't find the word its looking for. However now i need to copy a column only if 2 like functions return a true. The extract of code i'm using to search a row for 1 condition is shown below:

For Each rng1 In Range("b2:z2")
If rng1.Value Like ("*DOG*") Then
rng1.EntireColumn.Copy
Sheets("Data").Select
Columns("c:c").Select
ActiveSheet.Paste
Sheets("Imported Data").Select
End If
Next rng1

So basically the code looks for a cell containing 'DOG' in row 2 (b-z)then copies the entire column to a new sheet (data). However i only want it to copy it if it also finds a second condition in the same colum it finds 'DOG' eg: CAT. Basically the column should be copied if both the DOG and CAT in the same column is true. If both conditions aren't met it should move on.

Any help would be awesome.

Thanks,
Al

 

[Hermanito]

Something like this maybe:

Dim ConditionDogMet As Boolean
Dim ConditionCatMet As Boolean
ConditionDogMet=False
ConditionCatMet=False
For Each rng1 In Range("b2:z2")
If rng1.Value Like ("*DOG*") Then ConditionDogMet = True
If rng1.Value Like ("*CAT*") Then ConditionCatMet = True
If ConditionDogMet AND ConditionCatMet Then
    rng1.EntireColumn.Copy
    Sheets("Data").Select
    Columns("c:c").Select
    ActiveSheet.Paste
    Sheets("Imported Data").Select
End If
Next rng1

If you are doing this for multiple rows, make sure to reset the booleans to false before each For Next within each row
I haven't tested it... and your code could/should be cleaned up to avoid using Select, but that's another topic

 

[almodne]

Hey Hermantino, Thanks for the reply. In the end i basically embedded the same IF statement again after the first. It seems to work, but if anything shows that my constant use of 'select' is the least of my skill weakness

For Each rng In Range("b2:z2")
If rng.Value Like ("*DV*") Then
rng.Cells.Select
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Value Like ("SHK") Then
ActiveCell.EntireColumn.Select
Selection.Copy
Sheets("Data").Select
Columns("c:c").Select
ActiveSheet.Paste
Sheets("Imported Data").Select
End If
End If
Next rng

It looks for *DV* within the range, then checks that the cell above contains SHK. If so it copies it to another sheet.

 

[Hermanito]

Your solution would only work if both conditions are met in adjacent cells... if you use my method, both conditions may be met anywhere in the range of cells you are searching... I thought it was that that you were after...

 

[almodne]

When i looked at the data i realised that things i was searching for were always adjacent. However i've now switched to your code as its much cleaner and flexible for future use

 

[Hermanito]

Okay, now you got that working, it's time to clean up the Select statements

you can change the code inside the IF like this:

If ConditionDogMet AND ConditionCatMet Then
    rng1.EntireColumn.Copy Destination:=Sheets("Data").Columns("c:c")
End If

 

[almodne]

My Macro had to execute about 20 of those, its cut the time from 15-10 seconds to about 2 seconds



I'll try an avoid the selects in the future

 

[Hermanito]

hehe, nice...

Select and Activate are typical leftovers from the Macro recorder, in general you can do about anything and everything without them, and as you noticed, it's also faster

Your code can probably be sped up even more, but then you'd need to post more so we can offer suggestions...