Use Select / Case to find certain text

[marlea]

Hi-

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

The problem with my macro below is that it will pull data for titles that contain *only* the words "Unit Resource Book." How should I alter 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 "Unit 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 Sub

[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

--
HTHs Martin


"marlea" wrote:

>
> Hi-
>
> I need to move data from workbook1 to workbook2 based on the contents
> of Column C in workbook1. Column C contains book titles. If the title
> contains the words "Unit Resource Book", then the macro should pull
> data in other columns and populate workbook2.
>
> The problem with my macro below is that it will pull data for titles
> that contain *only* the words "Unit Resource Book." How should I alter
> 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 "Unit
> 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 Sub
>
>
> --
> marlea
> ------------------------------------------------------------------------
> marlea's Profile: http://www.excelforum.com/member.php...o&userid=26209
> View this thread: http://www.excelforum.com/showthread...hreadid=506510
>
>

[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" wrote:

>
> Hi-
>
> I need to move data from workbook1 to workbook2 based on the contents
> of Column C in workbook1. Column C contains book titles. If the title
> contains the words "Unit Resource Book", then the macro should pull
> data in other columns and populate workbook2.
>
> The problem with my macro below is that it will pull data for titles
> that contain *only* the words "Unit Resource Book." How should I alter
> 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 "Unit
> 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 Sub
>
>
> --
> marlea
> ------------------------------------------------------------------------
> marlea's Profile: http://www.excelforum.com/member.php...o&userid=26209
> View this thread: http://www.excelforum.com/showthread...hreadid=506510
>
>

[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