| Home | Forums | Reviews | Articles | Register |
![]() |
| Thread Tools | Rate Thread |
|
|
|
| |
|
Dave Peterson
Guest
Posts: n/a
|
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 |
|
||
|
||||
|
jsd219
Guest
Posts: n/a
|
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
Guest
Posts: n/a
|
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 |
|
||
|
||||
|
jsd219
Guest
Posts: n/a
|
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
Guest
Posts: n/a
|
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 |
|
||
|
||||
|
jsd219
Guest
Posts: n/a
|
:-) 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 oldwords. > > 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 thisscript > > > > > > 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
Guest
Posts: n/a
|
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
Guest
Posts: n/a
|
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 |
|
||
|
||||
|
jsd219
Guest
Posts: n/a
|
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 plainold 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 notdefined > > > > > > 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 LANGUAGELEARNING") > > > > > > > > > > > > > > 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 |
|
||
|
||||
|
|
|
| |
![]() |
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Converstion of Complex Word VBA macro to Excel Macro | Michael | Microsoft Excel Programming | 1 | 18th Jan 2008 12:21 AM |
| Re: Excel Macro call Word Macro with Parameters | =?Utf-8?B?Q3VydA==?= | Microsoft Excel Programming | 0 | 24th May 2007 12:21 AM |
| Convert WP 6.x Macro to Word 03 or 07 | =?Utf-8?B?RGVhbm5hIFJleW5vbGRz?= | Microsoft Word Document Management | 3 | 28th Mar 2007 02:48 AM |
| Need syntax for RUNning a Word macro with an argument, called from an Excel macro | Steve | Microsoft Excel Programming | 3 | 6th Jul 2006 07:42 PM |
| passing arguments from an excel macro to a word macro | =?Utf-8?B?S1dFMzk=?= | Microsoft Excel Misc | 1 | 7th Jul 2005 03:56 PM |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |




