convert a Word macro to an Excel macro

[Dave Peterson]

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

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

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.

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>>

 

[jsd219]

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

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

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

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]

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".

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

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

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>>

 

[jsd219]

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

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".

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

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]

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.

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

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".

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>>