Use Select / Case to find certain text

[marlea]

Hi-

I need to move data from workbook1 to workbook2 based on the content
of Column C in workbook1. Column C contains book titles. If the titl
contains the words "Unit Resource Book", then the macro should pul
data in other columns and populate workbook2.

The problem with my macro below is that it will pull data for title
that contain *only* the words "Unit Resource Book." How should I alte
my SELECT statement so that it isn't only looking for an exact match
i.e., I want it to find all titles that contain the words "Uni
Resource Book." Thank you!

Title examples:
Physical Science Unit Resource Book
Physical Science Unit Tests
Anatomy Unit Resource Book
Physioloy



Sub titles_Test2()
' Declare variables...
Dim bk1 As Workbook, bk2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim pgStart, pgEnd, newRow, counter As Integer
Dim activityTitle, activityID, pgRng, book, pdfName, ansKey As String
Dim rng1 As Range, cell As Range
Set bk1 = Workbooks("book1.xls")
Set bk2 = Workbooks("book2.xls")
Set sh1 = bk1.Worksheets("sheet1")
Set sh2 = bk2.Worksheets("sheet1")
Set rng1 = sh1.Range(sh1.Cells(2, 3), sh1.Cells(2, 3).End(xlDown))

newRow = 18

For Each cell In rng1

sh1.Activate
ActiveSheet.Range("C2").Select

' Get book
book = cell.Offset.Value

' Get page start
pgStart = cell.Offset(0, 1).Value

' Get page end
pgEnd = cell.Offset(0, 2).Value

' Get title
activityTitle = cell.Offset(0, 3).Value

' Get pdfName...
pdfName = cell.Offset(0, 8).Value

If pgEnd = pgStart Then
pgRng = pgStart
Else
pgRng = pgStart & "-" & pgEnd
End If

Select Case book
Case Is = "Unit Resource Book"

sh2.Cells(newRow, 3).Value = "English"

sh2.Cells(newRow, 7).Value = activityTitle

sh2.Cells(newRow, 8).Value = book

sh2.Cells(newRow, 12).Value = pgRng

sh2.Cells(newRow, 13).Value = pdfName
End Select

newRow = newRow + 1
Next
sh2.Activate
ActiveSheet.Range("A1").Select
End Su

 

[Martin Fishlock]

Try using the instr function and an if end if instead of a select case:

If InStr(1, book, "Unit Resource Book", vbTextCompare) > 0 Then ' found it
sh2.Cells(newRow, 3).Value = "English"
sh2.Cells(newRow, 7).Value = activityTitle
sh2.Cells(newRow, 8).Value = book
sh2.Cells(newRow, 12).Value = pgRng
sh2.Cells(newRow, 13).Value = pdfName
End If

 

[Toppers]

Hi,
Replace Select Case by:

If book Like "*Unit Resource Book*" Then

sh2.Cells(newRow, 3).Value = "English"

sh2.Cells(newRow, 7).Value = activityTitle

sh2.Cells(newRow, 8).Value = book

sh2.Cells(newRow, 12).Value = pgRng

sh2.Cells(newRow, 13).Value = pdfName
End If


HTH

 

[marlea]

Martin and Toppers: Thank you so much!! Both of your suggestions work

 

[musik]

Hi folks,

This is the same kind of thing that I need to do with a sheet I have
with lots of content. I am having trouble editing the macros provided
above to work for my sheet. I would be most apreciative if anyone could
offer me some pointers as I have very little experience with macros.

Basically I have my sheet set up like this

Column A: Title
Column B: Company
Column C: Address 1
Column D: Address 2
Column E: Address 3
Column F: Town
Column G: County
Column H: Postcode
Column I: Category

I need to be able to search Column B (Company) so it will pull anything
out that has the word 'Pizza' anywhere in the company name and put that
whole row of information in another workbook.

I've got a file already called book1.xls which contains Sheet1 - this
is where the content is. This contains 25474 rows of our contacts.

And book2.xls which contains Sheet1 for where the rows it pulls should
be placed.

If it's not too much trouble could someone help me get this working?

Cheers,
Rose