Rows and Coloumns

[Sahana]

Hello

I have a table with is divided into three coloums rows namely Name,
Grade, and Institute. I want the macros to be executed in Name and
Institute rows.

In some other instances I have used Name, Grade, and Institute as
coloums. I want the macros to be executed in Name and Institute
coloums.

What macros need to execute could be check for spaces.

Ideally every document is written using single spaces. But I have
pages where people have used more that one single space. Can macros
check for the same?

Thanks


Sahana

 

[Pesach Shelnitz]

Hi Sahana,

The following macro goes through all the tables in a document, checks the
first cell in each column to see if it matches any of your three headings. If
a match is found, the macro replaces any multiple spaces in the column with a
single space. Then the macro checks the first cell in each row in the table
to see if it matches any of your three headings. If a match is found, the
macro replaces any multiple spaces in the row wiht a single space.

Sub ChangeColumnsRows()
Dim myTable As table
Dim myCol As Column
Dim myRow As Row
Dim myCell As Cell
Dim findArray As Variant
Dim i As Long

findArray = Array("Name", "Grade", "Institute")
For Each myTable In ActiveDocument.Tables
For Each myCol In myTable.Columns
For i = 0 To UBound(findArray)
With myCol.Cells(1).Range
.MoveEnd wdCharacter, -1
If Trim(.Text) = findArray(i) Then
For Each myCell In myCol.Cells
With myCell.Range.Find
.Text = "^w"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
Next
End If
End With
Next
Next
For Each myRow In myTable.Rows
For i = 0 To UBound(findArray)
With myRow.Cells(1).Range
.MoveEnd wdCharacter, -1
If Trim(.Text) = findArray(i) Then
With myRow.Range.Find
.Text = "^w"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
End If
End With
Next
Next
Next
End Sub

I fell that I should mention that you can clean out all the multiple spaces
in a document without a macro by doing a simple search and replace. In the
Find box type ^w and in the Replace box type a space.

 

[Sahana]

Hi Sahana,

The following macro goes through all the tables in a document, checks the
first cell in each column to see if it matches any of your three headings.. If
a match is found, the macro replaces any multiple spaces in the column with a
single space. Then the macro checks the first cell in each row in the table
to see if it matches any of your three headings. If a match is found, the
macro replaces any multiple spaces in the row wiht a single space.

Sub ChangeColumnsRows()
    Dim myTable As table
    Dim myCol As Column
    Dim myRow As Row
    Dim myCell As Cell
    Dim findArray As Variant
    Dim i As Long

    findArray = Array("Name", "Grade", "Institute")
    For Each myTable In ActiveDocument.Tables
        For Each myCol In myTable.Columns
            For i = 0 To UBound(findArray)
                With myCol.Cells(1).Range
                    .MoveEnd wdCharacter, -1
                    If Trim(.Text) = findArray(i) Then
                        For Each myCell In myCol.Cells
                            With myCell.Range..Find
                                .Text ="^w"
                                .Replacement.Text = " "
                                .Forward = True
                                .Wrap =wdFindStop
                                .Execute Replace:=wdReplaceAll
                              End With
                        Next
                    End If
                End With
            Next
        Next
        For Each myRow In myTable.Rows
            For i = 0 To UBound(findArray)
                With myRow.Cells(1).Range
                    .MoveEnd wdCharacter, -1
                    If Trim(.Text) = findArray(i) Then
                        With myRow.Range.Find
                            .Text = "^w"
                            .Replacement.Text= " "
                            .Forward = True
                            .Wrap = wdFindStop
                            .Execute Replace:=wdReplaceAll
                        End With
                    End If
                End With
            Next
        Next
    Next
End Sub

I fell that I should mention that you can clean out all the multiple spaces
in a document without a macro by doing a simple search and replace. In the
Find box type ^w and in the Replace box type a space.

--
Hope this helps,
Pesach Shelnitz









- Show quoted text -

Hello Shelnitz

I tried to run your code in the a table where I have nultiple rows and
coloums. And where I have placed the above mentioned in different rows
and coloums. I get some error which says 5992- cannot access
individual columns in this collection because the table has mixed cell
widths.

Is it possible to generalize the code given by you? To elaborate, the
topics in the table be placed in any fashion.



Thanks

Sahana

 

[Pesach Shelnitz]

Hi Sahana,

You apparently have merged cells spanning two or more columns in your table.
I didn't consider that possibility when I wrote the macro. I could modify the
macro to skip columns with merged cells or to make the change to all cells in
the table regardless of the headings if any merged cells are found. Would
either of those possiblities suit your purposes?

 

[Sahana]

Hi Sahana,

You apparently have merged cells spanning two or more columns in your table.
I didn't consider that possibility when I wrote the macro. I could modifythe
macro to skip columns with merged cells or to make the change to all cells in
the table regardless of the headings if any merged cells are found. Would
either of those possiblities suit your purposes?
--
Hope this helps,
Pesach Shelnitz








- Show quoted text -

Hello Shelnitz

Hmm is it possible to check wrt to headings in a table without
considering if the item is placed in row or coloum, and merged or not?


Thanks

Sahana

 

[Pesach Shelnitz]

Hi Sahana,

As far as I know, if there are any merged cells in a table, macros cannot
work on cells in individual rows or columns except the first row. The
following macro goes through all the tables in a document, checks each cell
in the first row to see if it matches any of your three headings. If a match
is found, the macro replaces any multiple spaces in any cell in the table
with a single space. Merged cells are no problem for this macro.

Sub ChangeCells()
Dim myTable As table
Dim findArray As Variant
Dim i As Long
Dim c As Long
Dim hdFound As Boolean

findArray = Array("Name", "Grade", "Institute")
For Each myTable In ActiveDocument.Tables
hdFound = False
For c = 1 To myTable.Columns.Count
For i = 0 To UBound(findArray)
With myTable.Range.Cells(c).Range
.MoveEnd wdCharacter, -1
If Trim(.Text) = findArray(i) Then
hdFound = True
End If
End With
Next
Next
If hdFound = True Then
With myTable.Range.Find
.Text = "^w"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
End If
Next
End Sub

If this macro can be a basis for what you want to do, write back with more
details about what you want to do. For example, code can be added to examine
the content of each cell to determine what action to take.