I see you got more responses to your other post, too. (Where you gave more
info.)

Personally, I'd start a new thread. Lots of people may be skipping this one.

jsd219 wrote:

Thanks, :-)
you can't imagine how much this is helping me. i can't thank you
enough.

What i use the "myword" for is to find the proper cells in the spread
sheet the "myword" is the constant within the sheet.

Soooo, you up for one more? if not i fully understand and again thank
you for all of your help. if it is any consolation i am learning a tone
from your scripts hopefully i will be able to write my own soon.

God bless
jsd219

Dave Peterson wrote:
I don't understand what you mean by "myword to stay where it is".

You typed it into an inputbox.

Maybe....

For Each cell In rng
start_str = InStr(cell.Value, myword)
If start_str Then
cell.EntireRow.Interior.Color = RGB(204, 255, 204)
'put original string in adjacent cell
cell.offset(0,1).value = cell.value
'leave just that word in column N
cell.Value = myword
' cell.Characters(start_str, Mylen).Delete
End If
Next

===
.offset(0,1) means to "go" to the right one column.

.offset(0,0) isn't required. It means that there is no "movement".

jsd219 wrote:

Thank you :-)

Actually i started piecing things together and came up with this but i
am at a loss. instead of moving myword to the cell in the next column i
want myword to say where it is and everything else in that cell to move
over to the cell in the next column. i am going crazy trying to figure
this out.

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.Offset(0, 0).Value = myword
' cell.Characters(start_str, Mylen).Delete
End If
Next
End Sub

God bless
jsd219

Dave Peterson wrote:
VBA has sample code when you look under .find.

Option Explicit
Sub testme01()

Dim myRng As Range
Dim FoundCell As Range
Dim WhatToFind As String
Dim FirstAddress As String

WhatToFind = "asdf"

With Worksheets("sheet1")
Set myRng = .Range("a:a") 'say
End With

With myRng
Set FoundCell = .Cells.Find(What:=WhatToFind, _
After:=.Cells(.Cells.Count), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

If FoundCell Is Nothing Then
MsgBox "not found in: " & myRng.Address(0, 0)
Else
FirstAddress = FoundCell.Address
Do
'do your stuff that does all the work
'and put it into the adjacent(?) cell
FoundCell.Offset(0, 1).Value = "whatever you need here"

'look for more
Set FoundCell = .FindNext(FoundCell)

If FoundCell Is Nothing Then
Exit Do
ElseIf FoundCell.Address = FirstAddress Then
Exit Do
End If
Loop
End If
End With

End Sub

jsd219 wrote:

My bad i posted the wrong function.

One of my bigest issues is something as simple as: find cells within a
specified column that contain specified text. once these cells are
found i need to pull the specified text out of the cell and paste it in
another cell one column to the right, then color the entire row.
i have found several functions and put together several formulas to do
this but i sure would love to be able to run a macro that does this for
me. i have tones of rows i have to go through.

God bless
jsd219

Dave Peterson wrote:
Sometimes, you can loop through a specified range and plop the values into
cells:

Sub testme()
Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
myCell.Offset(0, 1).Value = ExtractDuration(myCell.Value)
Next myCell
End Sub

Heck, you may want to just add a formula to the cell that does the work:

=extractduration(a1)

You could have a macro apply that formula to a specific range, calculate, and
convert to values:

Dim myRng as range
set myrng = activesheet.range("a1:a10")
with myrng.offset(0,1)
.formular1c1 = "=extractduration(rc[-1])"
.value = .value
end with

There were parts missing from those functions, so I didnt' test any of this.

jsd219 wrote:

No prob, i have been reading the newsgroups and have figured out how to
open the pdf from excel, now i am working with sendkeys to see if i can
select all, copy, then paste. if i am successful i will let you know.
:-)

Is there an easy way to turn the 2 functions below into a script that
will place the results in a specified column?

Public Function ExtractDuration(InputString As String) As String

Dim astrWords() As String
Dim intWordToCheck As Integer
Dim strWordtoCheck As String
Dim astrTemp() As String
Dim intCounter As Integer

intCounter = 0
astrWords = Split(InputString, " ", -1, vbTextCompare)
intWordToCheck = UBound(astrWords)
strWordtoCheck = astrWords(intWordToCheck)
strWordtoCheck = EliminateCommas(strWordtoCheck)

Do Until NumbercommaNumber(strWordtoCheck) = False
ReDim Preserve astrTemp(intCounter)
astrTemp(intCounter) = strWordtoCheck
intCounter = intCounter + 1
intWordToCheck = intWordToCheck - 1
strWordtoCheck = astrWords(intWordToCheck)
strWordtoCheck = EliminateCommas(strWordtoCheck)
Loop

ExtractDuration = Join(astrTemp, vbLf)
End Function

Private Function NumbercommaNumber(InputString As String) As Boolean

Dim intPositionOfPeriod As Integer
Dim strLeftPart As String
Dim strRightPart As String

intPositionOfPeriod = InStr(1, InputString, "(", vbTextCompare)

Select Case intPositionOfPeriod
Case 1
NumbercommaNumber = False
Case Else
' there is a period in there
strLeftPart = Strings.Left(InputString, intPositionOfPeriod +
1)
' strRightPart = Strings.Mid(InputString, intPositionOfPeriod -
1)
If IsNumeric(strLeftPart) = True Then
' And IsNumeric(strRightPart) = True Then
NumbercommaNumber = True
Else
NumbercommaNumber = False
End If
End Select

End Function

<<snipped

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson