Macro Help

[kaurp]

Hi, I'm trying to write a macro that does a few different things. I have somethings working and others I'm having trouble with.



I need it to find a certain word within a table in word, select that row and change the height.

If the first row of a table is blank, delete it.

Convert a table to text if it starts with the word "Notes:" in the first cell.

If a certain page has a word in it but no table, delete that page.

There are some other things it needs to do that I already have working and here is what I have:

Public Sub ACF() 
     'Updates table of content
    ActiveDocument.TablesOfContents(1).Update 
     
     'Deletes last page if it's blank
    Dim i As Long 
    For i = ActiveDocument.Paragraphs.Count To 1 Step -1 
        If Asc(ActiveDocument.Paragraphs(i).Range.Text) = 12 Then 
            ActiveDocument.Paragraphs(i).Range.Delete 
            Exit For 
        End If 
        If Len(ActiveDocument.Paragraphs(i).Range.Text) > 1 Then 
            Exit For 
        End If 
    Next i 
     
     'Deletes table if they are blank
    Application.ScreenUpdating = False 
    Dim Tbl As Table, cel As Cell, n As Long, fEmpty As Boolean 
    With ActiveDocument 
        For Each Tbl In .Tables 
            n = Tbl.Rows.Count 
            For i = n To 1 Step -1 
                fEmpty = True 
                For Each cel In Tbl.Rows(i).Cells 
                    If Len(cel.Range.Text) > 2 Then 
                        fEmpty = False 
                        Exit For 
                    End If 
                Next cel 
                If fEmpty = True Then Tbl.Rows(i).Delete 
            Next i 
        Next Tbl 
    End With 
    Set cel = Nothing: Set Tbl = Nothing 
    Application.ScreenUpdating = True 
     
     'State table row heights
    Dim oTbl As Table, x As Integer, z As Integer 
    With oTbl 
        For i = .Rows.Count To 1 Step -1 
            With .Rows(i) 
                If .Cells.Count > 1 Then 
                    Set Rng = .Cells(1, 1).Range 
                    If FindText(Rng, "California") = True Then .HeightRule = wdRowHeightAtLeast 
                     
                End If 
            End With 
        Next 
    End With 
     
End Sub

[macropod]

Hi kaurp,

Try the following (it's a slightly enhanced version of your's and handles the 'Notes:' issue).

Regarding:

I need it to find a certain word within a table in word, select that row and change the height.

Your code looks for 'California', but then only sets the height rule - which doesn't of itself change the height. I've modified the code to make the height exactly 0.75in.

Regarding:

If a certain page has a word in it but no table, delete that page.

Pages are a rubbery concept in Word, as their layout and content is largely determined by the current print driver; what's empty with one printer may have content when another printer is used. Unless you're using manual page breaks and/or 'next page' section breaks to define the pages, you'll need a different approach.

Public Sub ACF()
Application.ScreenUpdating = False
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
     'Updates all tables of contents
    For i = 1 To .TablesOfContents.Count
      .TablesOfContents(i).Update
    Next i
     'Deletes last page if it's blank
    While .Range.Characters.Last.Previous = vbCr Or .Range.Characters.Last.Previous = Chr(12)
        .Range.Characters.Last.Previous.Delete
    Wend
    For i = .Tables.Count To 1 Step -1
        With .Tables(i)
            For j = .Rows.Count To 1 Step -1
                With .Rows(j)
                     'Deletes row if empty
                    If Len(.Range.Text) = (.Cells.Count * 2 + 2) Then
                        .Delete
                    Else
                         'Sets State row height
                        If .Cells.Count > 1 Then
                            Set Rng = .Cells(1).Range
                            If InStr(Rng, "California") > 0 Then
                                .HeightRule = wdRowHeightExactly
                                .Height = InchesToPoints(0.75)
                            End If
                            If Split(Rng.Text, " ")(0) = "Notes:" Then
                                .Range.Tables(1).ConvertToText
                                Exit For
                            End If
                        End If
                    End If
                End With
            Next j
        End With
    Next i
End With
Application.ScreenUpdating = True
End Sub

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.