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

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

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

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

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

Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:


DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.


Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

It works awesome, thank you so much. :-)

God bless
jsd219

PS. yes i wanted to delete the entire row

Dave Peterson wrote:
So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.


Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

works perfect, i can't thank you enough. :-)

God bless
jsd219


Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate....
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an....
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat....
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

Well, once we got rid of that awful MSWord stuff, it was pretty much clear
sailing. <vbg

jsd219 wrote:

works perfect, i can't thank you enough. :-)

God bless
jsd219

Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1
x Communication 1.1 Students engage in conversations, provide...
x Communication 1.2 Students understand and interpret....
x Communication 1.3 Students present information...
x Cultura
x Communication 1.3 Students present information...
x Cultures 2.1 Students demonstrate an understanding...
x Connections 3.1 Students reinforce and further...
x Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

The above is the snag. although the script adjustment works great i
have found it still takes some time due to the sixe of the spread
sheets. In the case above i need to take "Gramática en acción 1" and
paste it in front of the next three rows below. i then need to take
"Cultura" and paste it in the cell below until i hit "CORE INSTRUCTION"
once that is done i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1 - Communication 1.1 Students...
x Gramática en acción 1 - Communication 1.2 Students...
x Gramática en acción 1 - Communication 1.3 Students...
x Cultura - Communication 1.3 Students present information...
x Cultura - Cultures 2.1 Students demonstrate an understanding...
x Cultura - Connections 3.1 Students reinforce and further...
x Cultura - Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

I think this can be done based on the columns to the left with the
"x"s. In the top example you will notice three columns of "x"s and
notice where the "x" for "Gramática en acción 1" and "CORE
INSTRUCTION" fall.
OK, :-) can you alter your original script to use the input box for the
sStart and sEnd. once it finds the row to copy (based on the sStart) it
copies down until it hits a row with an "x' in the same tier. at that
point it copies the new cell down until it hits the sEnd (in this case
"CORE INSTRUCTION")

God bless
jsd219

PS. i don't want to be a bother so i do understand if you are not
interested



Dave Peterson wrote:
Well, once we got rid of that awful MSWord stuff, it was pretty much clear
sailing. <vbg

jsd219 wrote:

works perfect, i can't thank you enough. :-)

God bless
jsd219

Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

You have a difference in what you write and the "after" sample.

You write:

i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result

But you don't delete "Core instruction", you deleted Cultura.

And instead of looking for phrases like "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" and "CORE INSTRUCTION", it looks like we could just use the X's in the
first two columns.

Since the text is in column N, I'm gonna guess that the X's are in the previous
3 columns: K, L, and M.

X in column K will mean turn on or turn off the processing.
X in column L will mean to use that as the prefix string
and the X in column M will just hang around. The macro won't touch it.

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

Set wks = ActiveSheet

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

jsd219 wrote:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1
x Communication 1.1 Students engage in conversations, provide...
x Communication 1.2 Students understand and interpret....
x Communication 1.3 Students present information...
x Cultura
x Communication 1.3 Students present information...
x Cultures 2.1 Students demonstrate an understanding...
x Connections 3.1 Students reinforce and further...
x Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

The above is the snag. although the script adjustment works great i
have found it still takes some time due to the sixe of the spread
sheets. In the case above i need to take "Gramática en acción 1" and
paste it in front of the next three rows below. i then need to take
"Cultura" and paste it in the cell below until i hit "CORE INSTRUCTION"
once that is done i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1 - Communication 1.1 Students...
x Gramática en acción 1 - Communication 1.2 Students...
x Gramática en acción 1 - Communication 1.3 Students...
x Cultura - Communication 1.3 Students present information...
x Cultura - Cultures 2.1 Students demonstrate an understanding...
x Cultura - Connections 3.1 Students reinforce and further...
x Cultura - Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

I think this can be done based on the columns to the left with the
"x"s. In the top example you will notice three columns of "x"s and
notice where the "x" for "Gramática en acción 1" and "CORE
INSTRUCTION" fall.
OK, :-) can you alter your original script to use the input box for the
sStart and sEnd. once it finds the row to copy (based on the sStart) it
copies down until it hits a row with an "x' in the same tier. at that
point it copies the new cell down until it hits the sEnd (in this case
"CORE INSTRUCTION")

God bless
jsd219

PS. i don't want to be a bother so i do understand if you are not
interested

Dave Peterson wrote:
Well, once we got rid of that awful MSWord stuff, it was pretty much clear
sailing. <vbg

jsd219 wrote:

works perfect, i can't thank you enough. :-)

God bless
jsd219

Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

Sorry for the delay, you are correct i should have wrote "Cultura" not
"CORE INSTRUCTION"

It can't run based on columns only for the initial search and find
because there are several other items that fall in the same column as
"STANDARDS FOR FOREIGN LANGUAGE LEARNING" and "CORE INSTRUCTION"

The text is in column "N" but for the sake of this form i pulled alot
of columns and info out. the "x" for STANDARDS and CORE are in column
"F" (labeled Tier 4).
3 columns: F, G, and H.

God bless
jsd219


Dave Peterson wrote:
You have a difference in what you write and the "after" sample.

You write:

i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result

But you don't delete "Core instruction", you deleted Cultura.

And instead of looking for phrases like "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" and "CORE INSTRUCTION", it looks like we could just use the X's in the
first two columns.

Since the text is in column N, I'm gonna guess that the X's are in the previous
3 columns: K, L, and M.

X in column K will mean turn on or turn off the processing.
X in column L will mean to use that as the prefix string
and the X in column M will just hang around. The macro won't touch it.

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

Set wks = ActiveSheet

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

jsd219 wrote:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1
x Communication 1.1 Students engage in conversations, provide...
x Communication 1.2 Students understand and interpret....
x Communication 1.3 Students present information....
x Cultura
x Communication 1.3 Students present information....
x Cultures 2.1 Students demonstrate an understanding...
x Connections 3.1 Students reinforce and further....
x Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

The above is the snag. although the script adjustment works great i
have found it still takes some time due to the sixe of the spread
sheets. In the case above i need to take "Gramática en acción 1" and
paste it in front of the next three rows below. i then need to take
"Cultura" and paste it in the cell below until i hit "CORE INSTRUCTION"
once that is done i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1 - Communication 1.1 Students...
x Gramática en acción 1 - Communication 1.2 Students...
x Gramática en acción 1 - Communication 1.3 Students...
x Cultura - Communication 1.3 Students present information...
x Cultura - Cultures 2.1 Students demonstrate an understanding...
x Cultura - Connections 3.1 Students reinforce and further...
x Cultura - Comparisons 4.1 Students demonstrate....
x CORE INSTRUCTION

I think this can be done based on the columns to the left with the
"x"s. In the top example you will notice three columns of "x"s and
notice where the "x" for "Gramática en acción 1" and "CORE
INSTRUCTION" fall.
OK, :-) can you alter your original script to use the input box for the
sStart and sEnd. once it finds the row to copy (based on the sStart) it
copies down until it hits a row with an "x' in the same tier. at that
point it copies the new cell down until it hits the sEnd (in this case
"CORE INSTRUCTION")

God bless
jsd219

PS. i don't want to be a bother so i do understand if you are not
interested

Dave Peterson wrote:
Well, once we got rid of that awful MSWord stuff, it was pretty much clear
sailing. <vbg

jsd219 wrote:

works perfect, i can't thank you enough. :-)

God bless
jsd219

Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

I don't understand why the columns can't be used. If there are things between
those groupings, then they shouldn't have an X in column F.

And the the processing (bReplace) should have been toggled off at the end of the
"real" group.

You can change the columns that are used in this section.

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

jsd219 wrote:

Sorry for the delay, you are correct i should have wrote "Cultura" not
"CORE INSTRUCTION"

It can't run based on columns only for the initial search and find
because there are several other items that fall in the same column as
"STANDARDS FOR FOREIGN LANGUAGE LEARNING" and "CORE INSTRUCTION"

The text is in column "N" but for the sake of this form i pulled alot
of columns and info out. the "x" for STANDARDS and CORE are in column
"F" (labeled Tier 4).
3 columns: F, G, and H.

God bless
jsd219

Dave Peterson wrote:
You have a difference in what you write and the "after" sample.

You write:

i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result

But you don't delete "Core instruction", you deleted Cultura.

And instead of looking for phrases like "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" and "CORE INSTRUCTION", it looks like we could just use the X's in the
first two columns.

Since the text is in column N, I'm gonna guess that the X's are in the previous
3 columns: K, L, and M.

X in column K will mean turn on or turn off the processing.
X in column L will mean to use that as the prefix string
and the X in column M will just hang around. The macro won't touch it.

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

Set wks = ActiveSheet

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

jsd219 wrote:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1
x Communication 1.1 Students engage in conversations, provide...
x Communication 1.2 Students understand and interpret....
x Communication 1.3 Students present information...
x Cultura
x Communication 1.3 Students present information...
x Cultures 2.1 Students demonstrate an understanding...
x Connections 3.1 Students reinforce and further...
x Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

The above is the snag. although the script adjustment works great i
have found it still takes some time due to the sixe of the spread
sheets. In the case above i need to take "Gramática en acción 1" and
paste it in front of the next three rows below. i then need to take
"Cultura" and paste it in the cell below until i hit "CORE INSTRUCTION"
once that is done i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1 - Communication 1.1 Students...
x Gramática en acción 1 - Communication 1.2 Students...
x Gramática en acción 1 - Communication 1.3 Students...
x Cultura - Communication 1.3 Students present information...
x Cultura - Cultures 2.1 Students demonstrate an understanding...
x Cultura - Connections 3.1 Students reinforce and further...
x Cultura - Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

I think this can be done based on the columns to the left with the
"x"s. In the top example you will notice three columns of "x"s and
notice where the "x" for "Gramática en acción 1" and "CORE
INSTRUCTION" fall.
OK, :-) can you alter your original script to use the input box for the
sStart and sEnd. once it finds the row to copy (based on the sStart) it
copies down until it hits a row with an "x' in the same tier. at that
point it copies the new cell down until it hits the sEnd (in this case
"CORE INSTRUCTION")

God bless
jsd219

PS. i don't want to be a bother so i do understand if you are not
interested

Dave Peterson wrote:
Well, once we got rid of that awful MSWord stuff, it was pretty much clear
sailing. <vbg

jsd219 wrote:

works perfect, i can't thank you enough. :-)

God bless
jsd219

Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret...
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret...
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

i sent a part of the spread sheet to your email address. i just want to
make sure you get it.

God bless
jsd219


Dave Peterson wrote:
I don't understand why the columns can't be used. If there are things between
those groupings, then they shouldn't have an X in column F.

And the the processing (bReplace) should have been toggled off at the end of the
"real" group.

You can change the columns that are used in this section.

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

jsd219 wrote:

Sorry for the delay, you are correct i should have wrote "Cultura" not
"CORE INSTRUCTION"

It can't run based on columns only for the initial search and find
because there are several other items that fall in the same column as
"STANDARDS FOR FOREIGN LANGUAGE LEARNING" and "CORE INSTRUCTION"

The text is in column "N" but for the sake of this form i pulled alot
of columns and info out. the "x" for STANDARDS and CORE are in column
"F" (labeled Tier 4).
3 columns: F, G, and H.

God bless
jsd219

Dave Peterson wrote:
You have a difference in what you write and the "after" sample.

You write:

i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result

But you don't delete "Core instruction", you deleted Cultura.

And instead of looking for phrases like "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" and "CORE INSTRUCTION", it looks like we could just use the X's in the
first two columns.

Since the text is in column N, I'm gonna guess that the X's are in the previous
3 columns: K, L, and M.

X in column K will mean turn on or turn off the processing.
X in column L will mean to use that as the prefix string
and the X in column M will just hang around. The macro won't touch it.

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

Set wks = ActiveSheet

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

jsd219 wrote:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1
x Communication 1.1 Students engage in conversations, provide...
x Communication 1.2 Students understand and interpret....
x Communication 1.3 Students present information...
x Cultura
x Communication 1.3 Students present information...
x Cultures 2.1 Students demonstrate an understanding...
x Connections 3.1 Students reinforce and further...
x Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

The above is the snag. although the script adjustment works great i
have found it still takes some time due to the sixe of the spread
sheets. In the case above i need to take "Gramática en acción 1" and
paste it in front of the next three rows below. i then need to take
"Cultura" and paste it in the cell below until i hit "CORE INSTRUCTION"
once that is done i need to delete the original row that held
"Gramática en acción 1" and the original row that held "CORE
INSTRUCTION" here is the end result:

OK, first of all if you are tired of messing with me i understand and i
appreciate all of the help you have given me. if you are interested in
the next challenge: here it is:

x STANDARDS FOR FOREIGN LANGUAGE LEARNING
x Gramática en acción 1 - Communication 1..1 Students...
x Gramática en acción 1 - Communication 1..2 Students...
x Gramática en acción 1 - Communication 1..3 Students...
x Cultura - Communication 1.3 Students present information...
x Cultura - Cultures 2.1 Students demonstrate an understanding...
x Cultura - Connections 3.1 Students reinforce and further...
x Cultura - Comparisons 4.1 Students demonstrate...
x CORE INSTRUCTION

I think this can be done based on the columns to the left with the
"x"s. In the top example you will notice three columns of "x"s and
notice where the "x" for "Gramática en acción 1" and "CORE
INSTRUCTION" fall.
OK, :-) can you alter your original script to use the input box for the
sStart and sEnd. once it finds the row to copy (based on the sStart) it
copies down until it hits a row with an "x' in the same tier. at that
point it copies the new cell down until it hits the sEnd (in this case
"CORE INSTRUCTION")

God bless
jsd219

PS. i don't want to be a bother so i do understand if you are not
interested

Dave Peterson wrote:
Well, once we got rid of that awful MSWord stuff, it was pretty much clear
sailing. <vbg

jsd219 wrote:

works perfect, i can't thank you enough. :-)

God bless
jsd219

Dave Peterson wrote:
Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

sStart = Selection.Cells(1).Value

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

sEnd = Selection.Cells(Selection.Cells.Count).Value

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

bReplace = False
For Each myCell In myRng.Cells
If LCase(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell.Value
End If
End If
Next myCell


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




jsd219 wrote:

Question: i have run into a snag, i found some discrepancies with my
spreadsheet and need to adjust your script to accomodate the
discrepancies. instead of an input box asking me what text string to
start and end with, i need the sStart and sEnd to base things off my
selection and use the first row in my selection as the sStart and the
last row in my selection as the sEnd

God bless
jsd219

Dave Peterson wrote:
leaving (A:M, and N:IV alone)
should have asked:
leaving A:M, and O:IV alone)



Dave Peterson wrote:

So what happens with the cells/rows with "Vocabulario en acción 1" on them?

Do you delete the entire row or do you just delete that single cell and shift
everything up (leaving (A:M, and N:IV alone)?

I left some code at the bottom that you can change. But the way it is now, it
deletes the entire row.

Try this against a copy of your worksheet--just in case.

Option Explicit
Sub AddTextToCellsExcel2()

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

Set wks = ActiveSheet

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

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

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

sEnd = 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(myCell.Value) Like LCase(sStart & "*") Then
bReplace = True
myStr = myCell.Offset(1, 0).Value
If RngToDelete Is Nothing Then
Set RngToDelete = myCell.Offset(1, 0)
Else
Set RngToDelete = Union(myCell.Offset(1, 0), RngToDelete)
End If
ElseIf LCase(myCell.Value) Like LCase(sEnd & "*") Then
bReplace = False
Else
If bReplace = True Then
myCell.Value = myStr & " - " & myCell..Value
End If
End If
Next myCell

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

jsd219 wrote:

:-) here is an example of what i am trying to do:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1
Communication 1.2 Students understand and interpret....
Comparisons 4.1 Students demonstrate understanding...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1
Communication 1.1 Students engage in conversations...
Communication 1.2 Students understand and interpret....
Communication 1.3 Students present information...
Cultures 2.1 Students demonstrate an understanding...
Comparisons 4.2 Students demonstrate understanding...
CORE INSTRUCTION

Notice the difference with the two days. what i need to do is find the
cell in column "N" with the text string "STANDARDS FOR FOREIGN LANGUAGE
LEARNING" select the cell directly below this one and paste its
contents in front of all cells below in the same column intil i reach
the cell with "CORE INSTRUCTION"

The two days above would then look like this:

DAY 1
STANDARDS FOR FOREIGN LANGUAGE LEARNINGCORE INSTRUCTION
Vocabulario en acción 1 - Communication 1.2 Students understand...
Vocabulario en acción 1 - Comparisons 4.1 Students demonstrate...
CORE INSTRUCTION

DAY 2
STANDARDS FOR FOREIGN LANGUAGE LEARNING
Vocabulario en acción 1 - Communication 1.1 Students engage...
Vocabulario en acción 1 - Communication 1.2 Students...
Vocabulario en acción 1 - Communication 1.3 Students present...
Vocabulario en acción 1 - Cultures 2.1 Students demonstrate an...
Vocabulario en acción 1 - Comparisons 4.2 Students demonstrat...
CORE INSTRUCTION

i have 10,000 rows of this info that i need to go through and make
these changes to: what i love about Shauna's script is it allows me to
put in whatever text i want as a starting point and whatever text i
want as an ending point giving me freedon to make adjustments if needed
down the line. her script works perfect if i had everything in word. i
have everything in excel and there is no way i could move it to word,
there are too many formulas and scripts populating this spread sheet. i
pulled up the REF in the tools tab and selected Word which helped but i
still get the activedocument error. i tried several attempts to change
that line but i could not figure out what it needs to be to make this
run in excel. any help would be very much appreciated and thanks for
all of the help so far.

God bless
jsd219

Dave Peterson wrote:
Excel doesn't have an activedocument.

Are you trying to automate changes to a word document from excel or are you
trying to change values in an excel file?

If you're changing an excel file, make sure you select the range to adjust
before you run either of the macros.

If that doesn't work, you may want to describe what you want in plain old words.

jsd219 wrote:

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

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson

--

Dave Peterson