Macro for selecting pages and formatting of tables

ubns · #1 04-29-2012, 07:23 PM

a. How can we design the macro to make a selection from one particular page to another particular page?
b. Once selected, do the following in the tables within those pages:
i. Delete – All rows including Date.
ii. Delete – All rows starting with “age”.
iii. Delete – All Zero Rows.
iv. Remove all rows with % symbols in them.
v. Add $ sign to all the numbers.

vi. Replace “>” with “five blank spaces”
vii. Spacing of cell – Before 5 pt, After 2 pt.
viii. Change the font size to 9.

macropod · #2 04-29-2012, 10:13 PM

Hi umesh,

Do you want to process all tables, or just a particular table? If it's just a particular table, does the table have any unique content or a bookmark? In what format(s) are the dates? Do you want to match the case for 'age'? Do the zero rows have 0s or are they empty?

Your last two steps should be managed by applying an approriate Style to the table, not by hard-formatting its content.

ubns · #3 04-29-2012, 10:54 PM

Hi Paul,

I want to process all tables with in that pages range.

Dates are in the format 1 Jul 12, 1 Jul 13 etc.

For age no I do not want to match the case.

Zeros rows have all 0s except in the first cell - which has text.

The reason I do not want to manage the last two steps by styles is because of complications in the word document styles. The complication is due to the conversion from Open office to word format. when we do it disables some styles and some features of specific styles of word document.

Hope it was clear.

macropod · #4 04-30-2012, 12:27 AM

Hi umesh,

Try:

Code:

Sub FormatTables()
Application.ScreenUpdating = False
Dim oTbl As Table, oCel As Cell, Rng As Range, i As Long
With ActiveDocument
  For Each oTbl In .Tables
    On Error Resume Next
    With oTbl
      For i = .Rows.Count To 1 Step -1
        With .Rows(i)
          If .Cells.Count > 1 Then
            Set Rng = .Range
            If FindText(Rng, "/%") = True Then .Delete
            If FindText(Rng, "<[0-9]{1,2} [JFMASOND][anebrpyulgctov]{2} [0-9]{2}>") = True Then .Delete
            If FindText(Rng, "<[Aa][Gg][Ee]>") = True Then .Delete
            If FindText(Rng, "[A-Za-z0-9]") = False Then .Delete
            Rng.Start = .Cells(2).Range.Start
            If FindText(Rng, "[!0]") = False Then .Delete
          End If
        End With
      Next
      For Each oCel In .Range.Cells
        Set Rng = oCel.Range
        With Rng
          .End = .End - 1
          If IsNumeric(.Text) Then .Text = Format(.Text, "$#,##0")
        End With
      Next
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Text = "\<[ ]@"
        .Replacement.Text = "<"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@\<"
        .Replacement.Text = "<"
        .Execute Replace:=wdReplaceAll
        .Text = "\<"
        .Replacement.Text = "     "
        .Execute Replace:=wdReplaceAll
      End With
      .Range.Font.Size = 9
      .TopPadding = 5
      .BottomPadding = 2
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub
 
Function FindText(Rng As Range, StrFnd As String) As Boolean
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = True
  .Text = StrFnd
  .Replacement.Text = ""
  .Execute
End With
FindText = Rng.Find.Found
End Function

ubns · #5 04-30-2012, 05:19 PM

Hi Paul,

I have attached the document.

The requirements are same, and for clarification please look at my comments in the document.

I have stated the sections which should have macro run on them.

Also, there is some issue of highlighting, word does not allow me to change the highlight color using the "Text highlight color".

In total there are three comments in the document.

Regards

Umesh Banga

macropod · #6 04-30-2012, 07:35 PM

Hi umesh,

Try:

Code:

Sub FormatTables()
Application.ScreenUpdating = False
Dim oTbl As Table, oCel As Cell, Rng As Range, i As Long, bDel As Boolean
With ActiveDocument
  For Each oTbl In .Tables
    With oTbl
      Set Rng = .Cell(1, 1).Range
      Rng.End = Rng.End - 1
      If UCase(Rng.Text) <> "DATE" And UCase(Rng.Text) <> "PERIOD" Then GoTo NextTable
      For i = .Rows.Count To 1 Step -1
        With .Rows(i)
          If .Cells.Count > 1 Then
            Set Rng = .Range
            bDel = False
            If bDel = False Then bDel = FindText(Rng, "<[Aa][Gg][Ee]>")
            If bDel = False Then bDel = FindText(Rng, "%")
            If bDel = False Then bDel = FindText(Rng, "<[0-9]{1,2} [JFMASOND][anebrpyulgctov]{2} [0-9]{2}>")
            If bDel = False Then bDel = Not FindText(Rng, "[A-Za-z0-9\>]")
            If bDel = False Then
              Set Rng = oTbl.Rows(i).Range
              Rng.Start = Rng.Cells(2).Range.Start
              If Len(Rng.Text) > (Rng.Cells.Count + 1) * 2 Then
                bDel = Not FindText(Rng, "[A-Za-z1-9\>]")
              End If
            End If
          End If
          If bDel = True Then .Delete
        End With
      Next
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Text = "([0-9,.]{1,})"
        .Replacement.Text = "$\1"
        .Execute Replace:=wdReplaceAll
        .Text = "[$]{2,}"
        .Replacement.Text = "$"
        .Execute Replace:=wdReplaceAll
        .Text = "\>[ ]@"
        .Replacement.Text = ">"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@\>"
        .Replacement.Text = ">"
        .Execute Replace:=wdReplaceAll
        .Text = "\>"
        .Replacement.Text = "     "
        .Execute Replace:=wdReplaceAll
      End With
      .Range.Font.Size = 9
      .TopPadding = 5
      .BottomPadding = 2
    End With
NextTable:
  Next
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
 
Function FindText(Rng As Range, StrFnd As String) As Boolean
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = True
  .Text = StrFnd
  .Replacement.Text = ""
  .Execute
End With
FindText = Rng.Find.Found
End Function

Without knowing more about the code you're using for the highlighting, and what you expect from it, I can't comment on why you might not be getting the expected results.

ubns · #7 04-30-2012, 08:14 PM

Hi Paul,

1) Thanks it works almost perfectly, however

a) it deletes the top and bottom rows of some table.
b) The top row (see comment UB2) - can we leave those type of rows unchanged? Apologies did not realise earlier.

I have attached the result sheet for your reference.

2) Re: Highlight, I think I was not clear. I do not have any program or macro for highlight which I am trying to run.

My query was, if you will see this document, there is lot of text highlighted in yellow or green color. If I try to use the standard "TEXT highlight" feature of word to change to no color, it does not work. Can you see any reason for that? Does it work on your machine?

3) I have tried to decipher the code, some parts I understand and some obviously is beyond my level. However would it possible for you to tell me that how you have made it select between the selection of tables - Which particular line of code is directing it and giving the criteria to make certain selection of tables?

Regards

Umesh Banga

ubns · #8 04-30-2012, 08:16 PM

here it is.

macropod · #9 04-30-2012, 08:26 PM

Hi umesh,

Change:
If bDel = True Then .Delete
to:
If bDel = True And i > 1 Then .Delete

The code does not select any table. What it does is to loop through the table objects collection, looking for tables whose first cell has the word 'Date' or 'Period'. All of that is managed by:

Code:

  For Each oTbl In .Tables
    With oTbl
      Set Rng = .Cell(1, 1).Range
      Rng.End = Rng.End - 1
      If UCase(Rng.Text) <> "DATE" And UCase(Rng.Text) <> "PERIOD" Then GoTo NextTable

As for the unwanted colouring, that has been applied via shading, not by highlighting.

macropod · #10 04-30-2012, 08:37 PM

Actually, instead of changing:
If bDel = True Then .Delete
to:
If bDel = True And i > 1 Then .Delete
it would be more efficient to change:
For i = .Rows.Count To 1 Step -1
to:
For i = .Rows.Count To 2 Step -1

ubns · #11 04-30-2012, 09:07 PM

Thanks Paul, I have made the recommended changes, now it puts "$" sign in front of all items in row 1too. for example if row one has Jul 12, it changes to $ Jul 12.

Any idea about how to remove shading?

macropod · #12 04-30-2012, 09:23 PM

Hi umesh,

Change:
With Range.Find
to:

Code:

      Set Rng = .Range
      Rng.Start = Rng.Rows(2).Range.Start
      With Rng.Find

You can remove all shading (not highlighting) by adding the following code between the final 'Next' and 'End With' statements in the 'FormatTables' sub:

Code:

  With .Range.Font.Shading
    .ForegroundPatternColor = wdColorAutomatic
    .BackgroundPatternColor = wdColorAutomatic
  End With

ubns · #13 04-30-2012, 09:46 PM

Thanks Paul.

With regards to macro for shading , how can i apply that to whole document?

Regards

macropod · #14 04-30-2012, 09:49 PM

As I said:

Quote:

You can remove all shading (not highlighting) by adding the following code between the final 'Next' and 'End With' statements in the 'FormatTables' sub:

ubns · #15 04-30-2012, 10:01 PM

Hi Paul,

Thanks.

1) Re: Code, works fine does not see any problem, however it still deletes the bottom border of the tables. Any idea?

2) Re shading, thanks and I gotthe point, however when i do what you have suggestd, it only removes the shading from the table rather than the "whole word" document.

Regards

Umesh Banga

I have donethat, however it only changes

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Another Case of Automatic/Zombie Formatting of Tables	MKummerfeldt	Word Tables	0	10-31-2011 10:40 AM
Splitting multiple pages using macro	F5JASON	Excel Programming	0	07-27-2011 08:22 AM
Selecting the macro document	lars	Word VBA	0	08-19-2010 06:06 AM
Whacked formatting in tables (2007)	Roscoe	Word Tables	6	06-11-2010 02:48 PM
Keeping Tables from Splitting Between Pages	AlexPaoletti	Word Tables	2	05-18-2010 01:17 AM