0

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.

Community
  • 1
  • 1
Janet Delgado
  • 13
  • 1
  • 6
  • What is the question then? "The code doesnt work" doesnt really say much. – braX Jan 02 '20 at 04:44
  • For starters [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – Siddharth Rout Jan 02 '20 at 04:49
  • 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 Jan 02 '20 at 04:50
  • 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 Jan 02 '20 at 05:22

2 Answers2

1

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
Roxy
  • 26
  • 1
  • I do not think the idea was to put it in matchRow in sheet 2. Just in the next open row. So you need a boltRow = 2 and productRow = 2 outside for and then to add 1 inside the if after you set the value in sheet 2. – Jeremy Kahan Jan 02 '20 at 13:27
  • What I've seen, There are "Product ID" and "Bolt Pattern" every rows. That's why I didn't care about next open row. So if there are no "Product ID" or "Bolt Pattern" any row, my solution will be make empty row in sheet 2, and Jeremy your answer is the better solution, right. Thank you for your tip. – Roxy Jan 03 '20 at 02:19
  • Frankly, I don't know how to implement Jeremy's tip; but thank you very much Roxy. You're code works on my computer! Thank you very much. – Janet Delgado Jan 03 '20 at 03:49
  • If you end up with blank cells because some rows had no product ID or bolt pattern (which as @Roxy points out does not appear to be the case), you can remove them by selecting the column and following these instructions: https://www.ablebits.com/office-addins-blog/2018/11/28/remove-blank-cells-excel/ – Jeremy Kahan Jan 03 '20 at 03:53
1

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.

Jeremy Kahan
  • 3,796
  • 1
  • 10
  • 23