If Cell Contains This or That Paste onto Another Sheet

Question

I have 2 sheets in my workbook SheetJS and Sheet1. I have this code that partially matches cells in each row that contain the phrase "ABC" in SheetJS and copies them to Column D in Sheet1. It them partially matches cells that contain the phrase "123" in SheetJS and copies then to Column G in Sheet1.

How can I change the code to partially match cells in each row in Sheet1 containing either "ABC" or "132" and pastes the values to Column D in Sheet1?

I will write a similar macro to copy values into Column G in Sheet1

Sub Extract_Data_or()

    For Each cell In Sheets("SheetJS").Range("A1:ZZ200")

        matchrow = cell.Row

        If cell.Value Like "*ABC*" Then 

            Sheets("Sheet1").Range("D" & matchrow).Value = cell.Value

        ElseIf cell.Value Like "*123*" Then

            Sheets("Sheet1").Range("G" & matchrow).Value = cell.Value

        End If

    Next

End Sub

Any tips will help thank you!

You mean to replace `Like` ? If yes You can use `Instr()`. If no I don't really get your point. — Teamothy, Jan 08 '20 at 07:56
Does this answer your question? [How to use OR in if statement in VBA](https://stackoverflow.com/questions/45099602/how-to-use-or-in-if-statement-in-vba) — FunThomas, Jan 08 '20 at 07:56
You looping through a lot of cells. Can these values really be all over the place in `Range("A1:ZZ200")` or is it a specific column? Also, do you have a header row? If both can be answered with a "Yes", I would go with `AutoFilter` — JvdV, Jan 08 '20 at 08:06
@JvdV: A little off topic, but just a little... Do you know how to build 'CriteriaRange' in a different way than creating a range with Columns header and condition below them? I mean, is it possible to replace that by passing an array to the filter? Anyhow, I can state that AutoFilter is a kind of VBA Speedy Gonzales, but I would like to avoid creating a new range in order to use it... Even the Headers missing issue can be over-passed by automatically adding and replacing them after filtering. But, I couldn't figure up how to optimize the CriteriaRange creation, avoiding to create a new range. — FaneDuru, Jan 08 '20 at 09:46
Making the assumption that column D:D of "Sheet1" has 200 rows is correct? And, even if it contains data, they will be replaced with new data collected from "SheetJS" (in any cell of the set range) which respects the mentioned condition. Is that correct? — FaneDuru, Jan 08 '20 at 10:10
I guess you are aware that if more then one occurrence appear on the same row of "SheetJS", in the target column (D:D) only the last occurrence will be recorded. Is that OK with you? If any of them would also be OK, the code can be faster if, for a specific row, the algorithm find the first occurrence. If my previous assumptions are correct and you clarify this last issue, I think I can provide an array solution able to work very fast. — FaneDuru, Jan 08 '20 at 10:31
@FaneDuru, regarding your question, have a look [here](https://stackoverflow.com/q/58035116/9758194). I've been wondering about this myself in earlier stages. But, unfortunately, the method needs a `Range` object to work with. — JvdV, Jan 08 '20 at 10:39
@JvdV: I was afraid of that since all my (similar) attempts to use an array/variant variable failed. It is a stupid Excel approach, I think. At least, on my taste... Their application anyhow uses an array based on the specific range. The same with no possibility to return the AdvancedFilter result in an array. I can swear that before pasting in the destination range the data behind the filter are kept in an array... Thanks, anyhow! — FaneDuru, Jan 08 '20 at 10:53

score 1 · Accepted Answer · answered Jan 08 '20 at 08:07

Use OR logic.

Sub Extract_Data_or()
    For Each cel In Sheets("SheetJS").Range("A1:ZZ200")
        matchrow = cel.Row

        If (cel.Value Like "*ABC*") Or (cel.Value Like "*123*") Then
            Sheets("Sheet1").Range("D" & matchrow).Value = cel.Value
        End If
    Next
End Sub

FaneDuru · Answer 2 · 2020-01-09T09:34:31.717

I asked for some clarifications, bun not receiving any answer I will start from the next assumptions:

Column D:D of "Sheet1" contains 200 rows filled with data.

Private Sub Extract_Data_or_Arr()
  Dim rngArr As Variant, dArr As Variant
  Dim sh As Worksheet, i As Long, j As Long
  Dim lngOcc As Long, lngChanges As Long, boolFound As Boolean

  Set sh = Sheets("TestOcc")
   rngArr = Sheets("SheetJS").Range("A1:ZZ200").Value
   dArr = sh.Range("D1:D200").Value

    For i = 1 To UBound(rngArr, 1)
        boolFound = False
        For j = 1 To UBound(rngArr, 2)
          If InStr(rngArr(i, j), "ABC") > 0 Or InStr(CStr(rngArr(i, j)), "123") > 0 Then
              If Not boolFound Then lngChanges = lngChanges + 1
              lngOcc = lngOcc + 1: boolFound = True
              dArr(i, 1) = rngArr(i, j)
          End If
       Next j
    Next i
    sh.Range("D1:D200").Value = dArr
    MsgBox lngOcc & " occurrences, vesus " & lngChanges & " changes made."
End Sub

Finally it returns the number of occurrences versus number of changes made.

If Cell Contains This or That Paste onto Another Sheet

2 Answers2

Linked

Related