Copy Cells Containing Specific Text

[jawill40]

I'm attempting to copy all cells within a sheet in excel that contain specific text and then paste the copied text into a new sheet. However, I have no VBA knowledge and have so far attempted to use other posts here to accomplish my goal with no luck. It would be awesome if the macro asked what text I was looking for but if it cannot that is fine too, I wont be picky.

My issue I have is that I'm looking for a cell that contains "Photoeye": (including the " "). I have an unknown length of A-rows to search through as well, sometimes is several thousand rows, other times it is around 500.
The VBA code I am currently using is as follows, again I didnt make that code as it is from another post but I cannot seem to get it to work when looking for "Photoeye":

Sub PHOTOEYE_1()

Dim c As Range
Dim Source As Worksheet
Dim Target As Worksheet
Dim Target1 As Worksheet

Set Source = ActiveWorkbook.Worksheets("Sheet1")

For Each c In Source.Range("A1:A99999" & Source.Cells(Rows.Count, 1).End(xlUp).Row)
   If c = ""Photoeye:"" Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   ElseIf c = "Outros" Then
      c.EntireRow.Copy
      Target1.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Do the cells in col A have "Photoeye:" only, or is it part of a larger string?

 

[jawill40]

Hi & welcome to MrExcel.
Do the cells in col A have "Photoeye:" only, or is it part of a larger string?

There is more text within col A and it would typically look as follows:

[
{
"type": "ia.display.view",
"version": 0,
"props": {
"path": "Templates/PhotoEye",
"params": {
"Photoeye": "RE1_2_PE1",
"Status": false
}
},
"meta": {},
"position": {
"x": 0.8574,
"y": 0.2868,
"height": 0.0333,
"width": 0.0323
},
"custom": {},
"propConfig": {
"meta.name": {
"binding": {
"config": {
"path": "this.props.params.Photoeye"
},
"type": "property"
}
},
"props.params.Area": {
"binding": {
"config": {
"path": "view.custom.Area"
},
"type": "property"
}
}
}
}
]

All of this information is held within col A, however I am only looking for the purple text. Within that purple text I also really only need the RE1_2_PE1, portion however, I have an unknown number of col A that contains data like that above, so I have decide to, for now, search by just the "Photoeye: "

 

[jawill40]

There are times when I have several thousand rows within Col A to search through.

 

[Fluff]

Ok, try

For Each c In Source.Range("A1", Source.Cells(Rows.Count, 1).End(xlUp))
   If InStr(1, c.Value, """Photoeye"":", vbTextCompare) Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   ElseIf c = "Outros" Then
      c.EntireRow.Copy
      Target1.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c

Although you haven't assigned a sheet to either Target or Target1

 

[Marc L]

​

As the data seems to be JSon type so the smart way is to directly work on source rather than on a worksheet …​

 

[jawill40]

Ok, try

For Each c In Source.Range("A1", Source.Cells(Rows.Count, 1).End(xlUp))
   If InStr(1, c.Value, """Photoeye"":", vbTextCompare) Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   ElseIf c = "Outros" Then
      c.EntireRow.Copy
      Target1.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c

Although you haven't assigned a sheet to either Target or Target1

I havent assigned a sheet as for the moment I wanted to see if it would save the copied information to my clipboard and I could paste it manually. (Dont know if it works like that I have no VBA knowledge so if I need that do sheet1 and sheet2).
Also I forgot to delete some code from where I copied it as I only need it to search for the one thing "Photoeye": , could I just delete the ElseIf statement and it still work like so?:

Sub PHOTOEYE_1()

For Each c In Source.Range("A1", Source.Cells(Rows.Count, 1).End(xlUp))
   If InStr(1, c.Value, """Photoeye"":", vbTextCompare) Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c
End Sub

 

[Fluff]

could I just delete the ElseIf statement and it still work like so?:

Yup that's fine, although you still need to assign a sheet to Source & Target

 

[jawill40]

I havent assigned a sheet as for the moment I wanted to see if it would save the copied information to my clipboard and I could paste it manually. (Dont know if it works like that I have no VBA knowledge so if I need that do sheet1 and sheet2).
Also I forgot to delete some code from where I copied it as I only need it to search for the one thing "Photoeye": , could I just delete the ElseIf statement and it still work like so?:

Sub PHOTOEYE_1()

For Each c In Source.Range("A1", Source.Cells(Rows.Count, 1).End(xlUp))
   If InStr(1, c.Value, """Photoeye"":", vbTextCompare) Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c
End Sub

I do not know how to add a sheet to Source and Target to the code you created but the original code I copied had a few targets in them that I had to readd. So, would this work? Or could you add them to your code? (Apologies, I do not quite understand VBA as I have never used it before this week).

Sub PHOTOEYE_2()

Dim c As Range
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")

For Each c In Source.Range("A1:A" & Source.Cells(Rows.Count, 1).End(xlUp).Row)
   If c = """Photoeye"":" Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c
End Sub

 

[Fluff]

That should be fine, just replace the If c= line with the the line I used.