0

I tried searching on the site for a solution to this but I was unable to find an exact match. I'm trying to figure out a VBA code that will do the following:

  1. Search through a specified column
  2. Locate all matching values (non-specified)
  3. Copy the rows of said matching values
  4. Place them into a new worksheet or workbook (preferrably workbook)

Here is my problem. The value in the specified row can be 1 of over 300 unique values, so specifying each one in the VBA code would be a nightmare.

I understand filtering that specified column alphabetically will work, but how would I tell the macro to stop at the end of each group and copy it to a new sheet? Basically how would i have it say "If the next value doesn't match the current value, start a new book"? (IE: Search down column C and copy all rows that contain "Bat", then copy to new book, then search down column C and copy all rows containing "Car", then cop to new book)

Any help would be greatly appreciated!

Community
  • 1
  • 1
user2530086
  • 15
  • 4
  • 1
    You could put the values that you're looking for on a different sheet (which can be hidden if preferred), and then for each value in that list, perform a Find loop on the specified column to collect all matches and copy them to a new worksheet, after which perform a .Move on the worksheet (to move it to its own workbook, which will become the active workbook)and then save and close the active workbook and continue to the next value in your list. – tigeravatar Aug 14 '13 at 22:55
  • I'll give this a shot and get back. Thanks for the suggestion! – user2530086 Aug 15 '13 at 00:16

1 Answers1

0

assuming your data is grouped, ie, not something like:

batman
batman
robin
robin
batman

but instead:

batman
batman
batman
robin
robin

Then this will grab all contiguous chunks and shove them in their own workbook. It also assumes everything is in column A, so change that if you need to.

Sub grabber()
Dim thisWorkbook As Workbook
Set thisWorkbook = ActiveWorkbook
last = 1
For i = 1 To 18 'my sample had 18 rows, replace it with how many you have
If Range("A" & i) <> Range("A" & (i + 1)) Then
Range("A" & last & ":A" & i).Copy
Set NewBook = Workbooks.Add
NewBook.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
last = i + 1
thisWorkbook.Activate
End If
Next i
End Sub
chiliNUT
  • 18,989
  • 14
  • 66
  • 106