VBA loop through list

[neilkotze]

Hey gurus,

I have managed to write the below code to extract each line in a sheet that contains the data which is written in the inputbox and paste in to another sheet. I need to update this to loop through a list of data rather than use an inputbox for each. A new sheet will also need to be created during the loop so that the lines are pasted in to separate sheets.

strsearch = CStr(InputBox(""))

lastline = Range("A15000").End(xlUp).Row
j = 1

For i = 1 To lastline
    For Each c In Range("C" & i & ":Z" & i)
        If c.Text = strsearch Then
            tocopy = 1
        End If
    Next c
    If tocopy = 1 Then
        Rows(i).Copy Destination:=Sheets(3).Rows(j)
        j = j + 1
    End If
tocopy = 0
Next i

I haven't had much luck on my own thus far :/ Any help would be much appreciated! Thanks!

[walruseggman]

Please put your code in CODE tags. Edit your post, highlight your code, then press the # button in the text editor toolbar.

If you could provide a workbook with a before and after example of what you are trying to accomplish, that would help.

[neilkotze]

Thanks for the CODE tag tip walrus. Attached is a simple example workbook.

I want to create a list, then have the macro separate each line of the 'Master sheet' that contains that value in to a new sheet.

[walruseggman]

So in your example, the 12 and the 20 could be in either column?

Like create one sheet that has 12 in either column, then another sheet that has 20 in either column?

And would you like the newly created sheets to be named as the reference number they were searching for? (e.g. a tab name of "12", another tab named "20", etc.)

[neilkotze]

Correct, they could be in either column. In the actual spreadsheet I'm dealing with the 12 or the 20 could be in any columns between C and Z.

That would be great if the newly created sheets were named as the reference number.

Thanks again walrus, appreciate your quick responses!

[walruseggman]

Here you go. A couple things:

• You'll have to change the sheet names in the first couple lines to match your actual sheet names.
• The code isn't set up to handle multiple runnings of the code. Whgat I mean is that if you run this on your example sheet, it will create 12 and 20 tabs and copy the stuff over. If you tried running it again, it would fail because it would try to create sheets that already exist. So you'd have to delete the new sheets before running again.

That last bullet is fixable if it's an issue for you. I didn't address it in the code because I don't know what you want. You could either :

1. Delete the sheets each time the code is run, creating new sheets, or
2. Add the results to a sheet if it already exists, otherwise create a new sheet.

Sub neilkotze()

Set ws1 = Sheets("Master Sheet")
Set ws2 = Sheets("List  to loop through")

For Each Cell In ws2.Range("A2:A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row)
    With ws1.Range("C:Z")
    Set c = .Find(Cell.Value)
    If Not c Is Nothing Then
    FirstAdd = c.Address
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    ws.Name = Cell.Value
    OpenRow = 1
    Do
        c.EntireRow.Copy ws.Rows(OpenRow)
        OpenRow = OpenRow + 1
        Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> FirstAdd
    End If
    End With
Next
End Sub

[neilkotze]

Awesome, thanks so much!! It works perfectly. Made my day.

I should've thought of this question earlier, but at what stage of your code could I insert some formatting code? I'm hoping that it could be part of the loop so that the formatting is applied to each created sheet?

In relation to the last bullet point above could you please show me how to do option 2.? I would want the new data to override the existing data already in the sheets from the last time the macro was run.

Hope I'm not abusing your generosity with your time here :/

[walruseggman]

but at what stage of your code could I insert some formatting code?

Right before your Do loop starts. Just as examples, the syntax would look something like this. Of course it all depends on what formatting you want. The first line would bold every cell of the sheet, the second would make the header row A-D red colored. Like I said, just examples:

ws.Cells.Font.Bold = True
ws.Range("A1:D1").Interior.Color = vbRed

Give me a bit to write the code for option 2 and I'll post.

[neilkotze]

Thanks Walrus. I managed to add the formatting. One issue that has come up is that the code is copying rows if a cell contains 12 or 20, rather than the cell equaling 12 or 20.

Is there a way to change this?

[walruseggman]

Yes. Change your .Find line to

Set c = .Find(Cell.Value, look at:= xlWhole)