convert a Word macro to an Excel macro
Unfortunately neither one of those worked. the original script works
perfectly in word but my work is in excel. i am having problems with
the code below:
Set oTable = ActiveDocument.Tables(1)
For Each oRow In oTable.Rows
'Get the range of the cell
Set rngCell = oRow.Cells(1).Range
God bless
jsd219
Dave Peterson wrote:
Typo...
Dim myCell as range
In fact, a few typos!
Option Explicit
Sub AddTextToCellsExcel()
Dim myCell As Range
Dim myRng As Range
Set myRng = Selection
'or give it the range you need
'set myrng = worksheets("sheet9999").range("a1:c12")
For Each myCell In myRng.Cells
myCell.Value = myCell.Value & "CORE Instruction"
Next myCell
End Sub
'or....
Sub AddTextToCellsExcel2()
Dim myCell As Range
Dim myRng As Range
Dim sStart As String
Dim sEnd As String
sStart = InputBox(Prompt:="Text to search for", _
Default:="STANDARDS FOR FOREIGN LANGUAGE LEARNING")
sEnd = InputBox(Prompt:="Text to end with", _
Default:="CORE INSTRUCTION")
Set myRng = Selection
'or give it the range you need
'set myrng = worksheets("sheet9999").range("a1:c12")
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
myCell.Value = myCell.Value & sEnd
End If
Next myCell
End Sub
jsd219 wrote:
Both of them are giving me Compile error: User-defined type not defined
and then it highlights Dim myCell As ranges
God bless
jsd219
Dave Peterson wrote:
Maybe...
Option Explicit
Sub AddTextToCellsExcel()
Dim myCell as ranges
dim myRng as range
set myrng = selection
'or give it the range you need
'set myrng = worksheets("sheet9999").range("a1:c12")
for each mycell in myrng.cells
mycell.value = mycell.value & "CORE Instruction"
next mycell
sStart = InputBox(Prompt:="Text to search for", _
Default:="STANDARDS FOR FOREIGN LANGUAGE LEARNING")
sEnd = InputBox(Prompt:="Text to end with", _
Default:="CORE INSTRUCTION")
End Sub
===
Or maybe...
Option Explicit
Sub AddTextToCellsExcel()
Dim myCell as ranges
dim myRng as range
dim sStart as string
dim sEnd as string
sStart = InputBox(Prompt:="Text to search for", _
Default:="STANDARDS FOR FOREIGN LANGUAGE LEARNING")
sEnd = InputBox(Prompt:="Text to end with", _
Default:="CORE INSTRUCTION")
set myrng = selection
'or give it the range you need
'set myrng = worksheets("sheet9999").range("a1:c12")
for each mycell in myrng.cells
if lcase(mycell.value) like lcase(sstart & "*") then
mycell.value mycell.value & sEnd
next mycell
End Sub
jsd219 wrote:
Shauna Kelly wrote me a wonderful script but unfortunaltey she wrote it
in Word and i need it in Excel. can anyone help me convert this script
from Word to Excel?
Below is the script:
Option Explicit
Sub AddTextToCells()
Dim sStart As String
Dim sCopy As String
Dim sEnd As String
Dim oTable As Word.Table
Dim oRow As Word.Row
Dim rngCell As Word.Range
Dim rngCopy As Word.Range
Dim bReplace As Boolean
sStart = InputBox(Prompt:="Text to search for", _
Default:="STANDARDS FOR FOREIGN LANGUAGE LEARNING")
sEnd = InputBox(Prompt:="Text to end with", _
Default:="CORE INSTRUCTION")
Set oTable = ActiveDocument.Tables(1)
For Each oRow In oTable.Rows
'Get the range of the cell
Set rngCell = oRow.Cells(1).Range
'Omit the end of cell marker
rngCell.End = rngCell.End - 1
'Process the cell
If rngCell.Text = sStart Then
bReplace = True
'Get the replacement text
Set rngCopy = oRow.Next.Cells(1).Range
rngCopy.End = rngCopy.End - 1
sCopy = rngCopy.Text
'Delete the row following our row
oRow.Next.Delete
ElseIf rngCell.Text = sEnd Then
bReplace = False
ElseIf bReplace Then
rngCell.InsertBefore sCopy & " - "
End If
Next oRow
End Sub
Thanks in advance
God bles
jsd219
--
Dave Peterson
--
Dave Peterson
|