View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
jsd219 jsd219 is offline
external usenet poster
 
Posts: 68
Default macro to find extract and paste contents from one cell to another

is there a way to account for and eliminate the extra space caused by a
double digit number?
I changed this line to read: cell.value =
Right(cell.Value,len(Cell.Value) - start_Str + 3)

in order to account for double digit numbers but what happens is
everycell with single digit numbers now has a space at the begining,
i.e.

Families with Dogs Chapter 10

comes out:
Chapter 10 Families with Dogs

Families with Dogs Chapter 9

comes out:
Chapter 9 Families with Dogs

I now have a space before Chapter 9

i know i could just go in an change this manually but i have several
spread sheets with all kinds of scripts, formulas and functions
running. trying to remeber little things like that will cost me down
the line. :-)

Tom Ogilvy wrote:
Just a typo: I used my usual variable instead of the one you are using. I
also adjusted the formula.

Sub FindMoveColor()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer

myword = InputBox("Enter the search string ")
Mylen = Len(myword)

With Worksheets(InputBox("Enter the Worksheet"))
Set rng = .Range("N1", .Cells(.Rows.Count, "N").End(xlUp))
End With
For Each cell In rng
start_str = InStr(1,cell.Value, myword,vbTextCompare)
If start_str Then
cell.EntireRow.Interior.Color = RGB(204, 255, 204)
cell.offset(0,1).Value = Trim(Left(cell.Value,start_str-1))
cell.value = Right(cell.Value,len(Cell.Value) - start_Str + 1)
End If
Next
End Sub

--
Regards,
Tom Ogilvy


"jsd219" wrote in message
ps.com...
Thank you, only one problem left. It is not deleting the moved text
from the orginal cell.
Any ideas?

God bless
jsd219


Tom Ogilvy wrote:
Sub FindMoveColor()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer

myword = InputBox("Enter the search string ")
Mylen = Len(myword)

With Worksheets(InputBox("Enter the Worksheet"))
Set rng = .Range("N1", .Cells(.Rows.Count, "N").End(xlUp))
End With
For Each cell In rng
start_str = InStr(1,cell.Value, myword,vbTextCompare)
If start_str Then
cell.EntireRow.Interior.Color = RGB(204, 255, 204)
cell.offset(0,1).Value = Trim(Left(cell.Value,start_str-1))
cell.value = Right(cell.Value,len(Cell.Value) - Iloc)
End If
Next
End Sub

--
Regards,
Tom Ogilvy


"jsd219" wrote in message
ups.com...
Hi all,
Below is a sample of a cell:

Families with pets CHAPTER 1

I need to locate this cell, by searching for the "CHAPTER" text,
extract everything but CHAPTER 1, paste it in the cell adjacent to it,
leaving the original cell with "CHAPTER 1" only and "Families with
pets" will be in the next cell over, then color the entire row.

Here is what i have so far: from here i am at a loss. any help would be
much appreciated

Sub FindMoveColor()
Dim rng As Range
Dim cell As Range
Dim start_str As Integer

myword = InputBox("Enter the search string ")
Mylen = Len(myword)

With Worksheets(InputBox("Enter the Worksheet"))
Set rng = .Range("N1", .Cells(.Rows.Count, "N").End(xlUp))
End With
For Each cell In rng
start_str = InStr(cell.Value, myword)
If start_str Then
cell.EntireRow.Interior.Color = RGB(204, 255, 204)
cell.Copy
cell.Offset(0, 1).PasteSpecial
cell.Offset(0, 0).Value = myword
cell.Offset(0, 1).Characters(start_str, Mylen).Delete
End If
Next
End Sub

God bless
jsd219