Copy a cell from one sheet to another sheet if that cell contains a particular text

0
votes

I have compiled wheel data but want a VBA macro that copies any cell from sheet 1 (named: SheetSJ) that matches partial text, and then copies that cell's data into sheet 2. This is to make the data much easier to work with.

  1. Search each row for any cells in SheetJS that contain text "Product ID", if no matches then ignore
  2. If any cell (text) matches, copy that cell, and paste the contents to sheet 2 column B (beginning with row 2)
  3. Search each row for any cells in SheetJS that contain text "Bolt Pattern", if no matches then ignore
  4. If any cell (text) matches, copy that cell, and paste the contents to sheet 2 column D (beginning with row 2)

Wheel Data enter image description here

As evident in the picture, the data is all over the place in each column and thus the macro cannot use any particular cell for reference. It can only match text values (which are unique). 

Sub Test()
For Each Cell In Sheets(1).Range("A1:ZZ200")
    If Cell.Value = "Product ID" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
    End If
Next
End Sub

I managed to find some examples online but they copy the entire row not the individual cell.

2
excelvbaexcel-formula
What is the question then? "The code doesnt work" doesnt really say much. – braX
For starters How to avoid using Select in Excel VBA – Siddharth Rout
Basically just need help setting up and fixing the code. As stated, the code copies the entire row, I simply need the cell that contains the text in each row, to copied and pasted. – Janet Delgado
this really sounds more like a job for a query than for vba. Otherwise, you will want to look at the piece linked by @SiddharthRout. Also, your condition should be InStr( Cell.Value, "Product ID" )>0 – Jeremy Kahan

2 Answers

1
votes

How about this code?

I cannot use English well, but if you want, I will help you with my best.

Sub test()

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

        matchrow = cell.Row

        If cell.Value Like "*Product ID*" Then  'You have to use "Like" Operator if you want to use wildcard something like *,?,#...

            Sheets(2).Range("B" & matchrow).Value = cell.Value
            'I recommend you to use ".value" Property when deal only text, not else(like cell color, border... etc), rather than "select-copy-paste". It could be slower while hoping both sheets

        ElseIf cell.Value Like "*Bolt Pattern*" Then

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

        End If

    Next

End Sub
1
votes

I don't think you need a macro at all. In sheet2 column B, row 2, place the following formula:

=iferror(index(SheetJS!2:2,match("*Product ID*",SheetJS!2:2,0)),"")

The iferror part just keeps the cell empty if no match is found (as opposed to giving an ugly error message). Match tells how far into row 2 the product id occurs, and index goes that far in and gets the value. Now grab the handle at the bottom right corner of the cell, and drag it down as many rows as you have rows in the first sheet. That should bring all product IDs from Sheet JS into column B.

Similarly start in row 2 column D with

=iferror(index(SheetJS!2:2,match("*Bolt Pattern*",SheetJS!2:2,0)),"")

and drag that on down.

I'm assuming no row has more than one product id or bolt pattern, which appears to be true.

This approach does have a mild drawback, that it will leave a blank space in the sheet 2 column if the SheetJS does not have that entry in that row.