Conditional copy entire rows if cell value meets criteria - Excel VBA

CakzPrimz

Board Regular
Joined
Oct 6, 2017
Messages
57
Dear MrExcel,

In sheets "Data" I want to copy entire row only if cell value in column F, contents these string arrays, regardless the words in Upper case, Proper case or Lower case).

- Cement, it could be Type 5 cement, Cements, etc
- Spun
- Concrete

Copying entire rows into sheets "Collector" starting in row number 3.

Thank so much.
prima
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Are you saying the value must have Cement?

Like sally likes cement
Or
My cement is dry
Or

Is your cement hard

Or the cement's content is weak

And if that is true then:
Concrete

would not apply
 
Last edited:
Upvote 0
All sentences that content one of these three words, "cement", "spun", "concrete"
example:
- my cement is dry
- spun pile

Thank so much.
prima
 
Upvote 0
I will have to leave this question for someone else to answer.
Using 3 possible values and saying it may say with some value before and after is beyond my Knowledgebase.

I'm sure someone else here on this forum will have a answer
 
Upvote 0
I will have to leave this question for someone else to answer.
Using 3 possible values and saying it may say with some value before and after is beyond my Knowledgebase.

I'm sure someone else here on this forum will have a answer

Thanks so much anyway.
 
Upvote 0
I finally worked out a answer:
Try this:
Run this script from the sheet with all your data.
Will copy rows to sheet named Collector

Code:
Sub Filter_Me_Using_Array_With_Wildcard()
'Modified  10/2/2018  4:50:17 AM  EDT
Dim Lastrow As Long
Dim Lastrowa As Long
Dim c As Long
Dim Counter As Long
c = 6 ' Column Number Modify this to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row
Dim Del As Variant
Del = Array("cement", "spun", "concrete")
ans = UBound(Del)
    For i = 1 To ans + 1
        Lastrowa = Sheets("Collector").Cells(Rows.Count, c).End(xlUp).Row + 1
            If Lastrowa < 3 Then Lastrowa = 3
    
        With ActiveSheet.Cells(1, c).Resize(Lastrow)
            .AutoFilter 1, "*" & Del(i - 1) & "*"
            Counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
            If Counter > 1 Then
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Collector").Rows(Lastrowa)
            Else
                MsgBox "No values found"
            End If
                .AutoFilter
        End With
    Next
    MsgBox "Done"
End Sub
 
Upvote 0
Another option to consider. My code
- assumes 'Data' has a heading row in row 1.
- assumes that sheet 'Collector' contains nothing from row 3 down. That's just how I interpreted your comment "Copying entire rows into sheets "Collector" starting in row number 3". If there could be data below that and you want this new data below that, a modification can be made.
- copies all the rows at once so the original row order is maintained.
- can be run with either sheet active.

Code:
Sub Move_Rows()
  Dim lc As Long
  Dim rCrit As Range
  
  With Sheets("Data")
    lc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Set rCrit = .Cells(1, lc + 2).Resize(2)
    rCrit.Cells(2).Formula = "=COUNT(SEARCH({""cement"",""spun"",""concrete""},F2))"
    .UsedRange.Resize(, lc).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("Collector").Range("A3"), Unique:=False
    Sheets("Collector").Rows(3).Delete
    rCrit.ClearContents
  End With
End Sub

Just one other point to note: I don't know if it is possible with your data, but if a cell in column F of 'Data' contains two (or more) of the strings being searched for (eg "The concrete contains cement") then the code from post 6 will copy that row twice (or more) to the 'Collector' sheet.
 
Last edited:
Upvote 0
Dear My Answer Is This,

It works, with note:

- if the data to copy (sheet "Data") start in row # 2 it is running well except it copies also images in the range
- if the data to copy (sheet "Data") start in row # 3 while row 1 & 2 is blank, it will copy also the blank row # 1, # 2 (repeated copy)

Thank so much for your help and attention.

Problem 98% solved !

prima
 
Upvote 0
One answer is:
You said in your original post:
Copying entire rows into sheets "Collector" starting in row number 3.
That's why the pasting starts in Row 3

So did you want the copying to start in row 3 or the pasting to start in row 3?




Thank so much.
 
Upvote 0
Another option to consider. My code
- assumes 'Data' has a heading row in row 1.
- assumes that sheet 'Collector' contains nothing from row 3 down. That's just how I interpreted your comment "Copying entire rows into sheets "Collector" starting in row number 3". If there could be data below that and you want this new data below that, a modification can be made.
- copies all the rows at once so the original row order is maintained.
- can be run with either sheet active.

Code:
Sub Move_Rows()
  Dim lc As Long
  Dim rCrit As Range
  
  With Sheets("Data")
    lc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Set rCrit = .Cells(1, lc + 2).Resize(2)
    rCrit.Cells(2).Formula = "=COUNT(SEARCH({""cement"",""spun"",""concrete""},F2))"
    .UsedRange.Resize(, lc).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("Collector").Range("A3"), Unique:=False
    Sheets("Collector").Rows(3).Delete
    rCrit.ClearContents
  End With
End Sub

Just one other point to note: I don't know if it is possible with your data, but if a cell in column F of 'Data' contains two (or more) of the strings being searched for (eg "The concrete contains cement") then the code from post 6 will copy that row twice (or more) to the 'Collector' sheet.

Dear Peter,

I have tried to apply your code, but no record to copy at all to "Collector" sheet.
And I do not know the reason why.

Really appreciate for help and kind attention

Thank you
prima
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,337
Members
448,568
Latest member
Honeymonster123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top