convert a Word macro to an Excel macro

[jsd219]

ok, here is a sample of my spread sheet: Notice there are multiple
items in the same columns and this is only one section of the sheet.
there are several sections and each section has variations. I only need
to make adjustments between "STANDARDS FOR FOREIGN LANGUAGE LEARNING"
and "CORE INSTRUCTION".

the great thing about being able to select my sStart and sEnd is other
sheets might need adjustments in other parts of the sheet. i.e.
"OPTIONAL RESOURCES" and "PRACTICE OPTIONS"

BLOCK 2
x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Vocabulario en acción 1
x Communication 1.1 Students engage in conversations...
x Communication 1.2 Students understand and...
x Communication 1.3 Students present information...
x Gramática en acción 1
x Communication 1.2 Students understand and...
x Comparisons 4.1 Students demonstrate underst...
x Comparisons 4.2 Students demonstrate underst....
x CORE INSTRUCTION
x Warm -Up
x · (5 min.) See Bell Work 1.2 p. 10. 1.2
x Vocabulario en acción 1
x · (15 min.) Present ¡Exprésate! and...
x · (5 min.) Have students do...
x · (5 min.) Play Audio CD 1, Tr. 3 for...
x · (15 min.) Have students do ...
x · (5 min.) Present Nota cultural...
x · (5 min.) Show GramaVisión....
x · (10 min.) Present Gramática using...
x · (15 min.) Have students do Activities...
x · (8 min.) Have students use expressions...
x Wrap -Up
x · (2 min.) See Heritage Speakers, p. 14.
x OPTIONAL RESOURCES
x Suggestions and Activities
x · (10 min.) Comunicación (TE), p. 11. 1.1
x · (10 min.) Advanced Learners, p. 11. 1.1
x · (5 min.) For linguistic learners see...
x · (5 min.) For Activity 15 see Slower...
x · (5 min.) For Activity 15 for students...
x PRACTICE OPTIONS
x · Lab Book, pp. 13-14, 56
x · Cuaderno de vocabulario y...
x · ¡Exprésate! para hispanohablantes, pp. 4-7
x · Cuaderno de actividades, pp. 1-3
x · Activities for Communication, pp. 1-2, 55-56
x · Teaching Transparencies: Bell Work 1.2...
x · Video Guide, pp. 4-5, 6
x · TPR Storytelling Book, pp. x-1
x · Grammar Tutor for Students of...
x · Independent Study Guide, p. 1
x · Interactive Tutor (Disc 1) or DVD Tutor (Disc 1)
x · Online practice, Chapter 1...
BLOCK 3

I did try your code to see if columns-only would work and it made
adjustments to several other rows that did not need to be adjusted.

God bless
jsd219

 

[Dave Peterson]

Untested:

Option Explicit
Sub AddTextToCellsExcel3()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet
Dim RngToDelete As Range
Dim myStr As String
Dim bReplace As Boolean
Dim TurnOnOffCol As Long
Dim PrefixCol As Long
Dim sStart As String
Dim sEnd As String

Set wks = ActiveSheet

sStart = LCase("STANDARDS FOR FOREIGN LANGUAGE LEARNING")
sEnd = LCase("CORE INSTRUCTION")

With wks
Set myRng = .Range("N1", .Cells(.Rows.Count, "N").End(xlUp))

TurnOnOffCol = .Range("K1").Column
PrefixCol = .Range("L1").Column

bReplace = False
For Each myCell In myRng.Cells
If LCase(.Cells(myCell.Row, TurnOnOffCol).Value) = LCase("x") _
And (LCase(myCell.Value) Like sStart & "*") _
Or (LCase(myCell.Value) Like sEnd & "*") Then
'off turns to on
'and on turns to off
bReplace = Not bReplace
ElseIf LCase(.Cells(myCell.Row, PrefixCol).Value) = LCase("x") Then
myStr = myCell.Value & " - "
If RngToDelete Is Nothing Then
Set RngToDelete = myCell
Else
Set RngToDelete = Union(myCell, RngToDelete)
End If
Else
If bReplace = True Then
myCell.Value = myStr & myCell.Value
End If
End If
Next myCell
End With

If RngToDelete Is Nothing Then
'do nothing
Else
'delete the entire row
RngToDelete.EntireRow.Delete
'or just that cell in Column N
'RngToDelete.Delete Shift:=xlUp
End If

End Sub

ok, here is a sample of my spread sheet: Notice there are multiple
items in the same columns and this is only one section of the sheet.
there are several sections and each section has variations. I only need
to make adjustments between "STANDARDS FOR FOREIGN LANGUAGE LEARNING"
and "CORE INSTRUCTION".

the great thing about being able to select my sStart and sEnd is other
sheets might need adjustments in other parts of the sheet. i.e.
"OPTIONAL RESOURCES" and "PRACTICE OPTIONS"

BLOCK 2
x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Vocabulario en acción 1
x Communication 1.1 Students engage in conversations...
x Communication 1.2 Students understand and...
x Communication 1.3 Students present information...
x Gramática en acción 1
x Communication 1.2 Students understand and...
x Comparisons 4.1 Students demonstrate underst...
x Comparisons 4.2 Students demonstrate underst....
x CORE INSTRUCTION
x Warm -Up
x · (5 min.) See Bell Work 1.2 p. 10. 1.2
x Vocabulario en acción 1
x · (15 min.) Present ¡Exprésate! and...
x · (5 min.) Have students do...
x · (5 min.) Play Audio CD 1, Tr. 3 for...
x · (15 min.) Have students do ...
x · (5 min.) Present Nota cultural...
x · (5 min.) Show GramaVisión....
x · (10 min.) Present Gramática using...
x · (15 min.) Have students do Activities...
x · (8 min.) Have students use expressions...
x Wrap -Up
x · (2 min.) See Heritage Speakers, p. 14.
x OPTIONAL RESOURCES
x Suggestions and Activities
x · (10 min.) Comunicación (TE), p. 11. 1.1
x · (10 min.) Advanced Learners, p. 11. 1.1
x · (5 min.) For linguistic learners see...
x · (5 min.) For Activity 15 see Slower...
x · (5 min.) For Activity 15 for students...
x PRACTICE OPTIONS
x · Lab Book, pp. 13-14, 56
x · Cuaderno de vocabulario y...
x · ¡Exprésate! para hispanohablantes, pp. 4-7
x · Cuaderno de actividades, pp. 1-3
x · Activities for Communication, pp. 1-2, 55-56
x · Teaching Transparencies: Bell Work 1.2...
x · Video Guide, pp. 4-5, 6
x · TPR Storytelling Book, pp. x-1
x · Grammar Tutor for Students of...
x · Independent Study Guide, p. 1
x · Interactive Tutor (Disc 1) or DVD Tutor (Disc 1)
x · Online practice, Chapter 1...
BLOCK 3

I did try your code to see if columns-only would work and it made
adjustments to several other rows that did not need to be adjusted.

God bless
jsd219

 

[jsd219]

I got it to work by changing

from:
Set myRng =.Range("N1", .Cells(.Rows.Count, "N").End(xlUp))
to:
Set myRng = Selection

but i have lost the ability to input a string of text in an input box
for the beginning and input another string of text in an input box for
the end

God bless
jsd219

 

[Dave Peterson]

replace these lines:

with:

sStart = lcase(InputBox(Prompt:="Text to search for", _
Default:="STANDARDS FOR FOREIGN LANGUAGE LEARNING"))

If Trim(sStart) = "" Then
MsgBox "quitting!"
Exit Sub
End If

sEnd = lcase(InputBox(Prompt:="Text to end with", _
Default:="CORE INSTRUCTION"))

If Trim(sEnd) = "" Then
MsgBox "Quitting"
Exit Sub
End If

From one of those other posts.

I got it to work by changing

from:
Set myRng =.Range("N1", .Cells(.Rows.Count, "N").End(xlUp))
to:
Set myRng = Selection

but i have lost the ability to input a string of text in an input box
for the beginning and input another string of text in an input box for
the end

God bless
jsd219

 

[jsd219]

I did not work. it deleted several rows that should not have been
deleted. i can work with just selecting the sections. i don't want to
bother you anymore with this, i really appreciate everything you have
done.

God bless
jsd219

PS. is there a way to have VBA open a PDF document select the contents
and paste them into an excel spread sheet?

 

[Dave Peterson]

One more to try (and tested):

Option Explicit
Sub AddTextToCellsExcel3()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet
Dim RngToDelete As Range
Dim myStr As String
Dim bReplace As Boolean
Dim TurnOnOffCol As Long
Dim PrefixCol As Long
Dim sStart As String
Dim sEnd As String

Set wks = ActiveSheet

With wks
Set myRng = .Range("N1", .Cells(.Rows.Count, "N").End(xlUp))

TurnOnOffCol = .Range("K1").Column
PrefixCol = .Range("L1").Column

sStart = LCase(InputBox(Prompt:="Text to search for", _
Default:="STANDARDS FOR FOREIGN LANGUAGE LEARNING"))

If Trim(sStart) = "" Then
MsgBox "quitting!"
Exit Sub
End If

sEnd = LCase(InputBox(Prompt:="Text to end with", _
Default:="CORE INSTRUCTION"))

If Trim(sEnd) = "" Then
MsgBox "Quitting"
Exit Sub
End If

bReplace = False
For Each myCell In myRng.Cells
If (LCase(.Cells(myCell.Row, TurnOnOffCol).Value) = LCase("x")) _
And (LCase(myCell.Value) Like sStart & "*") Then
bReplace = True
ElseIf (LCase(.Cells(myCell.Row, TurnOnOffCol).Value) _
= LCase("x")) _
And (LCase(myCell.Value) Like sEnd & "*") Then
bReplace = False
ElseIf LCase(.Cells(myCell.Row, PrefixCol).Value) = LCase("x") _
And bReplace = True Then
myStr = myCell.Value & " - "
If RngToDelete Is Nothing Then
Set RngToDelete = myCell
Else
Set RngToDelete = Union(myCell, RngToDelete)
End If
Else
If bReplace = True Then
myCell.Value = myStr & myCell.Value
End If
End If
Next myCell
End With

If RngToDelete Is Nothing Then
'do nothing
Else
RngToDelete.EntireRow.Delete
End If

End Sub

I did not work. it deleted several rows that should not have been
deleted. i can work with just selecting the sections. i don't want to
bother you anymore with this, i really appreciate everything you have
done.

God bless
jsd219

PS. is there a way to have VBA open a PDF document select the contents
and paste them into an excel spread sheet?

 

[jsd219]

!!You rock!!

This is awesome. thank you so much.

by the way is there a way to open up acrobat with VBA and select the
contents of the pdf, copy them and paste them into an excel spread
sheet?

God bless
jsd219

 

[Dave Peterson]

I've never had good luck copying the data from a .pdf file and pasting into
excel manually. It always comes in all jumbled up. (Sometimes, copying column
by column helps.)

But I don't know a way to automate it.

!!You rock!!

This is awesome. thank you so much.

by the way is there a way to open up acrobat with VBA and select the
contents of the pdf, copy them and paste them into an excel spread
sheet?

God bless
jsd219

 

[jsd219]

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

 

[jsd219]

in case you were interested:

Sub AcroURLCopyPaste()
Dim sUrl$
Dim myRng As Range
Dim wks As Worksheet

Set wks = ActiveSheet
Set myRng = Selection

'ActiveSheet.Cells.ClearContents
' place your exact path to the file you want to open
sUrl = "C:\REPLACE THIS TEXT WITH PATH TO FILE.pdf"
ActiveWorkbook.FollowHyperlink (sUrl)
Application.Wait Now + TimeSerial(0, 0, 5)
SendKeys "^0", True
SendKeys "v", True
SendKeys "+({PGDN 1})", True
SendKeys "^a", True
SendKeys "+({PGDN 1})", True
SendKeys "^c", True
'sendkeys "%{f4}"
ActiveSheet.Paste

End Sub

God bless
jsd219

 

[Dave Peterson]

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]

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

 

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