How to get perform this operation only in the current Cell of a ta

Hi,

I have a macro that splits the cells that have Hard returns inside all the
tables in my current document into separate rows. Someone sent me this
macro below to perform this function.

If I need this macro to operate only on the current Cell where my cursor
is and not all the tables in my document, how should I modify this?


Macro Below:

Sub RowSplit()

For x = 1 To ThisDocument.Tables.Count

For Each r In ThisDocument.Tables(x).Rows

If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then

rowsArray = Split(r.Cells(1).Range, Chr(13))
nSubRowCount = UBound(rowsArray)

If nSubRowCount > 1 Then
r.Select

For i = nSubRowCount To 1 Step -1
If Len(Replace(rowsArray(i), Chr(7), "")) > 0
Then
Selection.InsertRowsBelow
ThisDocument.Tables(x).Cell(r.Index + 1,
1).Range = rowsArray(i)
r.Select
End If
Next
Selection.Range = rowsArray(0)
End If

End If

Next
Next

End Sub

Julian
Thu Feb 28 08:16:02 PST 2008

That code seems to assume there is only once cell per row, if your table
really does have just once cell per row this should work...

Remove the two outer loops (tables and rows) and just use "Set r =
selection.row"

If however your table has more than one cell per row

the line

If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then

should probably become (so you only test the cell the you are in)

if InStr(1,selection.cells(1), Chr(13)) < Len(r.Cells(1).Range) then

NB I didn't attend too closely to the rest of the detail... not very good at
reading other people's code... styles & preferences differ! If you have
further problems please ask again...

HTH

Julian

"vrk1" <vrk1@discussions.microsoft.com> wrote in message
news:1E9F49E4-B5A0-463F-978A-67FD9DF6B849@microsoft.com...
> Hi,
>
> I have a macro that splits the cells that have Hard returns inside all the
> tables in my current document into separate rows. Someone sent me this
> macro below to perform this function.
>
> If I need this macro to operate only on the current Cell where my cursor
> is and not all the tables in my document, how should I modify this?
>
>
> Macro Below:
>
> Sub RowSplit()
>
> For x = 1 To ThisDocument.Tables.Count
>
> For Each r In ThisDocument.Tables(x).Rows
>
> If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then
>
> rowsArray = Split(r.Cells(1).Range, Chr(13))
> nSubRowCount = UBound(rowsArray)
>
> If nSubRowCount > 1 Then
> r.Select
>
> For i = nSubRowCount To 1 Step -1
> If Len(Replace(rowsArray(i), Chr(7), "")) > 0
> Then
> Selection.InsertRowsBelow
> ThisDocument.Tables(x).Cell(r.Index + 1,
> 1).Range = rowsArray(i)
> r.Select
> End If
> Next
> Selection.Range = rowsArray(0)
> End If
>
> End If
>
> Next
> Next
>
> End Sub
>

--
Julian I-Do-Stuff

Some Vista stuff, but mostly just Stuff at http://berossus,blogspot.com

JeanGuyMarcil
Thu Feb 28 08:36:04 PST 2008

"vrk1" wrote:

> Hi,
>
> I have a macro that splits the cells that have Hard returns inside all the
> tables in my current document into separate rows. Someone sent me this
> macro below to perform this function.
>
> If I need this macro to operate only on the current Cell where my cursor
> is and not all the tables in my document, how should I modify this?
>
>
> Macro Below:
>
> Sub RowSplit()
>
> For x = 1 To ThisDocument.Tables.Count
>
> For Each r In ThisDocument.Tables(x).Rows
>
> If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then
>
> rowsArray = Split(r.Cells(1).Range, Chr(13))
> nSubRowCount = UBound(rowsArray)
>
> If nSubRowCount > 1 Then
> r.Select
>
> For i = nSubRowCount To 1 Step -1
> If Len(Replace(rowsArray(i), Chr(7), "")) > 0
> Then
> Selection.InsertRowsBelow
> ThisDocument.Tables(x).Cell(r.Index + 1,
> 1).Range = rowsArray(i)
> r.Select
> End If
> Next
> Selection.Range = rowsArray(0)
> End If
>
> End If
>
> Next
> Next
>
> End Sub

You mean like this:

Sub RowSplit()

Dim i As Long
Dim r As Long
Dim rowsArray() As String
Dim nSubRowCount As Long
Dim rgeCell As Range

Set rgeCell = Selection.Range

With Selection.Cells(1)
If InStr(1, r, Chr(13)) < Len(.Range) Then
rowsArray = Split(.Range, Chr(13))
nSubRowCount = UBound(rowsArray)
If nSubRowCount > 1 Then
Selection.Rows(1).Select
r = Selection.Rows(1).Index
For i = 0 To nSubRowCount
If Len(Replace(rowsArray(i), Chr(7), "")) > 0 Then
r = r + 1
Selection.InsertRowsBelow
Selection.Tables(1).Cell(r, 1).Range = rowsArray(i)
Selection.Tables(1).Rows(r).Select
End If
Next
End If
End If
End With

rgeCell.Select

End Sub

Julian
Thu Feb 28 08:37:22 PST 2008

Sorry - forgot the second replacement in the line it should of course have
become

if InStr(1,selection.cells(1), Chr(13)) < Len(selection.cells(1).Range) then

"Julian" <msforums@tiger2.notthisbit.demon.co.uk> wrote in message
news:ec6e7UieIHA.3724@TK2MSFTNGP02.phx.gbl...
> That code seems to assume there is only once cell per row, if your table
> really does have just once cell per row this should work...
>
> Remove the two outer loops (tables and rows) and just use "Set r =
> selection.row"
>
> If however your table has more than one cell per row
>
> the line
>
> If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then
>
> should probably become (so you only test the cell the you are in)
>
> if InStr(1,selection.cells(1), Chr(13)) < Len(r.Cells(1).Range) then
>
> NB I didn't attend too closely to the rest of the detail... not very good
> at reading other people's code... styles & preferences differ! If you have
> further problems please ask again...
>
> HTH
>
> Julian
>
> "vrk1" <vrk1@discussions.microsoft.com> wrote in message
> news:1E9F49E4-B5A0-463F-978A-67FD9DF6B849@microsoft.com...
>> Hi,
>>
>> I have a macro that splits the cells that have Hard returns inside all
>> the
>> tables in my current document into separate rows. Someone sent me this
>> macro below to perform this function.
>>
>> If I need this macro to operate only on the current Cell where my cursor
>> is and not all the tables in my document, how should I modify this?
>>
>>
>> Macro Below:
>>
>> Sub RowSplit()
>>
>> For x = 1 To ThisDocument.Tables.Count
>>
>> For Each r In ThisDocument.Tables(x).Rows
>>
>> If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then
>>
>> rowsArray = Split(r.Cells(1).Range, Chr(13))
>> nSubRowCount = UBound(rowsArray)
>>
>> If nSubRowCount > 1 Then
>> r.Select
>>
>> For i = nSubRowCount To 1 Step -1
>> If Len(Replace(rowsArray(i), Chr(7), "")) > 0
>> Then
>> Selection.InsertRowsBelow
>> ThisDocument.Tables(x).Cell(r.Index + 1,
>> 1).Range = rowsArray(i)
>> r.Select
>> End If
>> Next
>> Selection.Range = rowsArray(0)
>> End If
>>
>> End If
>>
>> Next
>> Next
>>
>> End Sub
>>
>
> --
> Julian I-Do-Stuff
>
> Some Vista stuff, but mostly just Stuff at http://berossus,blogspot.com

--
Julian I-Do-Stuff

Some Vista stuff, but mostly just Stuff at http://berossus,blogspot.com

vrk1
Thu Feb 28 10:51:08 PST 2008

Thank you Julian and Jean for your response.

My requirement slightly changed and due to this I have changed the macro in
line with your suggestions as below:

Here is my requirement:
I need to highlight a particular row in a Table and run a macro. The macro
looks for all hard return characters in the 1st cell and splits the table
wherever there is a Hard return. For instance, if the 1st cell has 4 hard
returns, then the macro should create 4 rows and place the text in those 4
rows as separate cells. The macro below is able to do that. However, I have
outline numbering (Styles) associated with these 4 lines and they are getting
messed up. I want the macro to be able to preserve the initial Outline
numbering scheme that I originally had.

Does anyone know how to achieve this please?

Here is my Macro:
Sub SplitSelectedRow()

If Selection.Type = 4 Then '4 represents the type Row

rowsArray = Split(Selection.Cells(1).Range, Chr(13))

nSubRowCount = UBound(rowsArray)

If nSubRowCount > 1 Then
Selection.Cells(1).Range = rowsArray(0)
For i = nSubRowCount To 1 Step -1
If Len(Replace(rowsArray(i), Chr(7), "")) > 0 Then
Selection.InsertRowsBelow
Selection.Range = rowsArray(i)
Selection.MoveUp
End If
Next

End If
End If

End Sub


"Jean-Guy Marcil" wrote:

> "vrk1" wrote:
>
> > Hi,
> >
> > I have a macro that splits the cells that have Hard returns inside all the
> > tables in my current document into separate rows. Someone sent me this
> > macro below to perform this function.
> >
> > If I need this macro to operate only on the current Cell where my cursor
> > is and not all the tables in my document, how should I modify this?
> >
> >
> > Macro Below:
> >
> > Sub RowSplit()
> >
> > For x = 1 To ThisDocument.Tables.Count
> >
> > For Each r In ThisDocument.Tables(x).Rows
> >
> > If InStr(1, r, Chr(13)) < Len(r.Cells(1).Range) Then
> >
> > rowsArray = Split(r.Cells(1).Range, Chr(13))
> > nSubRowCount = UBound(rowsArray)
> >
> > If nSubRowCount > 1 Then
> > r.Select
> >
> > For i = nSubRowCount To 1 Step -1
> > If Len(Replace(rowsArray(i), Chr(7), "")) > 0
> > Then
> > Selection.InsertRowsBelow
> > ThisDocument.Tables(x).Cell(r.Index + 1,
> > 1).Range = rowsArray(i)
> > r.Select
> > End If
> > Next
> > Selection.Range = rowsArray(0)
> > End If
> >
> > End If
> >
> > Next
> > Next
> >
> > End Sub
>
> You mean like this:
>
> Sub RowSplit()
>
> Dim i As Long
> Dim r As Long
> Dim rowsArray() As String
> Dim nSubRowCount As Long
> Dim rgeCell As Range
>
> Set rgeCell = Selection.Range
>
> With Selection.Cells(1)
> If InStr(1, r, Chr(13)) < Len(.Range) Then
> rowsArray = Split(.Range, Chr(13))
> nSubRowCount = UBound(rowsArray)
> If nSubRowCount > 1 Then
> Selection.Rows(1).Select
> r = Selection.Rows(1).Index
> For i = 0 To nSubRowCount
> If Len(Replace(rowsArray(i), Chr(7), "")) > 0 Then
> r = r + 1
> Selection.InsertRowsBelow
> Selection.Tables(1).Cell(r, 1).Range = rowsArray(i)
> Selection.Tables(1).Rows(r).Select
> End If
> Next
> End If
> End If
> End With
>
> rgeCell.Select
>
> End Sub
>

JeanGuyMarcil
Thu Feb 28 12:12:02 PST 2008

"vrk1" wrote:

> Thank you Julian and Jean for your response.
>
> My requirement slightly changed and due to this I have changed the macro in
> line with your suggestions as below:
>
> Here is my requirement:
> I need to highlight a particular row in a Table and run a macro. The macro
> looks for all hard return characters in the 1st cell and splits the table
> wherever there is a Hard return. For instance, if the 1st cell has 4 hard
> returns, then the macro should create 4 rows and place the text in those 4
> rows as separate cells. The macro below is able to do that. However, I have
> outline numbering (Styles) associated with these 4 lines and they are getting
> messed up. I want the macro to be able to preserve the initial Outline
> numbering scheme that I originally had.
>
> Does anyone know how to achieve this please?
>
> Here is my Macro:
> Sub SplitSelectedRow()
>
> If Selection.Type = 4 Then '4 represents the type Row
>
> rowsArray = Split(Selection.Cells(1).Range, Chr(13))
>
> nSubRowCount = UBound(rowsArray)
>
> If nSubRowCount > 1 Then
> Selection.Cells(1).Range = rowsArray(0)
> For i = nSubRowCount To 1 Step -1
> If Len(Replace(rowsArray(i), Chr(7), "")) > 0 Then
> Selection.InsertRowsBelow
> Selection.Range = rowsArray(i)
> Selection.MoveUp
> End If
> Next
>
> End If
> End If
>
> End Sub
>

Like this? (By the way, 5 is the Row type, not 4)
Also, I notice that you use code without declaring variables... Not a good
idea, especially when you get into larger projects that require debugging.


Sub SplitSelectedRow()

Dim rgePara As Range
Dim nSubRowCount As Long
Dim i As Long

If Selection.Type = 5 Then
nSubRowCount = Selection.Cells(1).Range.Paragraphs.Count
If nSubRowCount > 1 Then
Set rgePara = Selection.Cells(1).Range
For i = 1 To nSubRowCount
With Selection
.InsertRowsBelow
With .Cells(1).Range
.Text = rgePara.Paragraphs(i).Range.Text
.Characters(.Characters.Count - 1).Delete
.Paragraphs(1).Format = rgePara.Paragraphs(i).Format
End With
End With
Next
End If
End If

End Sub

vrk1
Thu Feb 28 12:30:07 PST 2008

Wow! You are amazing. thank you very much!

"Jean-Guy Marcil" wrote:

> "vrk1" wrote:
>
> > Thank you Julian and Jean for your response.
> >
> > My requirement slightly changed and due to this I have changed the macro in
> > line with your suggestions as below:
> >
> > Here is my requirement:
> > I need to highlight a particular row in a Table and run a macro. The macro
> > looks for all hard return characters in the 1st cell and splits the table
> > wherever there is a Hard return. For instance, if the 1st cell has 4 hard
> > returns, then the macro should create 4 rows and place the text in those 4
> > rows as separate cells. The macro below is able to do that. However, I have
> > outline numbering (Styles) associated with these 4 lines and they are getting
> > messed up. I want the macro to be able to preserve the initial Outline
> > numbering scheme that I originally had.
> >
> > Does anyone know how to achieve this please?
> >
> > Here is my Macro:
> > Sub SplitSelectedRow()
> >
> > If Selection.Type = 4 Then '4 represents the type Row
> >
> > rowsArray = Split(Selection.Cells(1).Range, Chr(13))
> >
> > nSubRowCount = UBound(rowsArray)
> >
> > If nSubRowCount > 1 Then
> > Selection.Cells(1).Range = rowsArray(0)
> > For i = nSubRowCount To 1 Step -1
> > If Len(Replace(rowsArray(i), Chr(7), "")) > 0 Then
> > Selection.InsertRowsBelow
> > Selection.Range = rowsArray(i)
> > Selection.MoveUp
> > End If
> > Next
> >
> > End If
> > End If
> >
> > End Sub
> >
>
> Like this? (By the way, 5 is the Row type, not 4)
> Also, I notice that you use code without declaring variables... Not a good
> idea, especially when you get into larger projects that require debugging.
>
>
> Sub SplitSelectedRow()
>
> Dim rgePara As Range
> Dim nSubRowCount As Long
> Dim i As Long
>
> If Selection.Type = 5 Then
> nSubRowCount = Selection.Cells(1).Range.Paragraphs.Count
> If nSubRowCount > 1 Then
> Set rgePara = Selection.Cells(1).Range
> For i = 1 To nSubRowCount
> With Selection
> .InsertRowsBelow
> With .Cells(1).Range
> .Text = rgePara.Paragraphs(i).Range.Text
> .Characters(.Characters.Count - 1).Delete
> .Paragraphs(1).Format = rgePara.Paragraphs(i).Format
> End With
> End With
> Next
> End If
> End If
>
> End Sub
>