convert a Word macro to an Excel macro
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
|