looping through tables omitting certain tables.

A

andreas

Dear Experts:

I wonder if the following is feasible using an input Box.

Say, a document has 30 tables. I would like to do stuff to these
tables via a macro but not to all of them. Let's assume that tables 4,
7-10, 12-15 should be skipped on the "For each loop". I now would
like the macro to bring up an InputBox at the beginning, where I could
fill in the tables which should not be touched, like

4;7;10-12;12-15.

Is that possible?

Regards,

Andreas
 
C

Cindy M.

Hi Andreas,
Say, a document has 30 tables. I would like to do stuff to these
tables via a macro but not to all of them. Let's assume that tables 4,
7-10, 12-15 should be skipped on the "For each loop". I now would
like the macro to bring up an InputBox at the beginning, where I could
fill in the tables which should not be touched, like

4;7;10-12;12-15.

Is that possible?
Click to expand...

Yes, the following appears to work fine, here:

Sub LoopThroughSelectedTables()
Dim nrList As String
Dim aIndexes() As Variant
Dim counter As Long
Dim nrTables As Long

nrList = InputBox("Enter the table indexes")
aIndexes() = ExtractNumbersFromString(nrList, ";", "-")
nrTables = ActiveDocument.Tables.Count
For counter = LBound(aIndexes()) To UBound(aIndexes())
If aIndexes(counter) <= nrTables Then
MsgBox "Table index: " & aIndexes(counter) & "." & vbCr & _
"Nr. rows: " & ActiveDocument.Tables(aIndexes
(counter)).Rows.Count
Else
MsgBox "There are only " & nrTables & " tables in the
document." & vbCr & _
"You are trying to address table index " & aIndexes
(counter) & "!"
Exit For
End If
Next
End Sub

Function ExtractNumbersFromString(nrList As String, _
sepSingle As String, sepGroup As String) As Variant
Dim aNumbers() As Variant
Dim entry As String, startNr As String, endNr As String
Dim s As String
Dim posSingle As Long, posGroup As Long
Dim aCounter As Long, nrCounter As Long

s = nrList
aCounter = 0
Do
posSingle = InStr(s, sepSingle)
posGroup = InStr(s, sepGroup)
If (posSingle > 0 And posGroup > 0) _
And posSingle < posGroup Then
entry = Mid(s, 1, posSingle - 1)
If IsNumeric(entry) Then
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = entry
aCounter = aCounter + 1
End If
s = Mid(s, posSingle + 1)
ElseIf (posSingle > 0 And posGroup > 0) _
And posSingle > posGroup Then
startNr = Mid(s, 1, posGroup - 1)
endNr = Mid(s, posGroup + 1, (posSingle) - (posGroup + 1))
If IsNumeric(startNr) And IsNumeric(endNr) Then
For nrCounter = startNr To endNr
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = nrCounter
aCounter = aCounter + 1
Next
End If
s = Mid(s, posSingle + 1)
ElseIf posSingle > 0 Then
entry = Mid(s, 1, posSingle - 1)
If IsNumeric(entry) Then
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = entry
aCounter = aCounter + 1
End If
s = Mid(s, posSingle + 1)
ElseIf posGroup > 0 Then
startNr = Mid(s, 1, posGroup - 1)
endNr = Mid(s, posGroup + 1)
If IsNumeric(startNr) And IsNumeric(endNr) Then
For nrCounter = startNr To endNr
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = nrCounter
aCounter = aCounter + 1
Next
End If
s = Mid(s, posGroup + 1, Len(endNr))
Else
'What's left should be a number
entry = s
If IsNumeric(entry) Then
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = entry
aCounter = aCounter + 1
End If
s = ""
End If
Loop Until Len(s) = 0
ExtractNumbersFromString = aNumbers
End Function


Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :)
 
A

andreas-hermle

Hi Andreas,


Yes, the following appears to work fine, here:

Sub LoopThroughSelectedTables()
    Dim nrList As String
    Dim aIndexes() As Variant
    Dim counter As Long
    Dim nrTables As Long

    nrList = InputBox("Enter the table indexes")
    aIndexes() = ExtractNumbersFromString(nrList, ";", "-")
    nrTables = ActiveDocument.Tables.Count
    For counter = LBound(aIndexes()) To UBound(aIndexes())
        If aIndexes(counter) <= nrTables Then
            MsgBox "Table index: " & aIndexes(counter) & "." & vbCr & _
                "Nr. rows: " & ActiveDocument.Tables(aIndexes
(counter)).Rows.Count
        Else
            MsgBox "There are only " & nrTables & " tables inthe
document." & vbCr & _
                "You are trying to address table index " & aIndexes
(counter) & "!"
            Exit For
        End If
    Next
End Sub

Function ExtractNumbersFromString(nrList As String, _
  sepSingle As String, sepGroup As String) As Variant
    Dim aNumbers() As Variant
    Dim entry As String, startNr As String, endNr As String
    Dim s As String
    Dim posSingle As Long, posGroup As Long
    Dim aCounter As Long, nrCounter As Long

    s = nrList
    aCounter = 0
    Do
        posSingle = InStr(s, sepSingle)
        posGroup = InStr(s, sepGroup)
        If (posSingle > 0 And posGroup > 0) _
  And posSingle < posGroup Then
            entry = Mid(s, 1, posSingle - 1)
            If IsNumeric(entry) Then
                ReDim Preserve aNumbers(aCounter)
                aNumbers(aCounter) = entry
                aCounter = aCounter + 1
            End If
            s = Mid(s, posSingle + 1)
        ElseIf (posSingle > 0 And posGroup > 0) _
  And posSingle > posGroup Then
            startNr = Mid(s, 1, posGroup - 1)
            endNr = Mid(s, posGroup + 1, (posSingle) - (posGroup + 1))
            If IsNumeric(startNr) And IsNumeric(endNr) Then
                For nrCounter = startNr To endNr
                     ReDim Preserve aNumbers(aCounter)
                    aNumbers(aCounter) = nrCounter
                    aCounter = aCounter + 1
                Next
            End If
            s = Mid(s, posSingle + 1)
        ElseIf posSingle > 0 Then
            entry = Mid(s, 1, posSingle - 1)
            If IsNumeric(entry) Then
                ReDim Preserve aNumbers(aCounter)
                aNumbers(aCounter) = entry
                aCounter = aCounter + 1
            End If
            s = Mid(s, posSingle + 1)
        ElseIf posGroup > 0 Then
            startNr = Mid(s, 1, posGroup - 1)
            endNr = Mid(s, posGroup + 1)
            If IsNumeric(startNr) And IsNumeric(endNr) Then
                For nrCounter = startNr To endNr
                    ReDim Preserve aNumbers(aCounter)
                    aNumbers(aCounter) = nrCounter
                    aCounter = aCounter + 1
                Next
            End If
            s = Mid(s, posGroup + 1, Len(endNr))
        Else
        'What's left should be a number
            entry = s
            If IsNumeric(entry) Then
                ReDim Preserve aNumbers(aCounter)
                aNumbers(aCounter) = entry
                aCounter = aCounter + 1
            End If
            s = ""
        End If
    Loop Until Len(s) = 0
    ExtractNumbersFromString = aNumbers
End Function

Cindy Meister
INTER-Solutions, Switzerlandhttp://homepage.swissonline.ch/cindymeister(last update Jun 17 2005)http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :)
Click to expand...

Hi Cindy,

I am deeply impressed! What a code! Thank you very much for your
professional help. Regrettably I am not able to integrate the
following code into your superb code:

------------------------------
Set tbl = ActiveDocument.Tables(i)
For Each oRw In ActiveDocument.Tables(i).rows
If Not oRw.Cells.Shading.BackgroundPatternColor =
wdColorAutomatic Then
oRw.Cells.Shading.BackgroundPatternColor =
wdColorGray25
End If
Next
-----------------------------------------------------

Where does this code snippet go?

Help is much appreciated. Thank you so much in advance. Again, this
is very nice of you to be so helpful. Regards, Andreas
 
D

Doug Robbins - Word MVP

Use:

Dim i As Long
Dim tbl As Table
Dim oRw As Row
For i = 1 To ActiveDocument.Tables.Count
Set tbl = ActiveDocument.Tables(i)
Select Case i
Case 1 To 4, 11, Is > 15
For Each oRw In tbl.Rows
If Not oRw.Cells.Shading.BackgroundPatternColor =
wdColorAutomatic Then
oRw.Cells.Shading.BackgroundPatternColor = wdColorGray25
End If
Next
End Select
Next i


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
Hi Andreas,


Yes, the following appears to work fine, here:

Sub LoopThroughSelectedTables()
Dim nrList As String
Dim aIndexes() As Variant
Dim counter As Long
Dim nrTables As Long

nrList = InputBox("Enter the table indexes")
aIndexes() = ExtractNumbersFromString(nrList, ";", "-")
nrTables = ActiveDocument.Tables.Count
For counter = LBound(aIndexes()) To UBound(aIndexes())
If aIndexes(counter) <= nrTables Then
MsgBox "Table index: " & aIndexes(counter) & "." & vbCr & _
"Nr. rows: " & ActiveDocument.Tables(aIndexes
(counter)).Rows.Count
Else
MsgBox "There are only " & nrTables & " tables in the
document." & vbCr & _
"You are trying to address table index " & aIndexes
(counter) & "!"
Exit For
End If
Next
End Sub

Function ExtractNumbersFromString(nrList As String, _
sepSingle As String, sepGroup As String) As Variant
Dim aNumbers() As Variant
Dim entry As String, startNr As String, endNr As String
Dim s As String
Dim posSingle As Long, posGroup As Long
Dim aCounter As Long, nrCounter As Long

s = nrList
aCounter = 0
Do
posSingle = InStr(s, sepSingle)
posGroup = InStr(s, sepGroup)
If (posSingle > 0 And posGroup > 0) _
And posSingle < posGroup Then
entry = Mid(s, 1, posSingle - 1)
If IsNumeric(entry) Then
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = entry
aCounter = aCounter + 1
End If
s = Mid(s, posSingle + 1)
ElseIf (posSingle > 0 And posGroup > 0) _
And posSingle > posGroup Then
startNr = Mid(s, 1, posGroup - 1)
endNr = Mid(s, posGroup + 1, (posSingle) - (posGroup + 1))
If IsNumeric(startNr) And IsNumeric(endNr) Then
For nrCounter = startNr To endNr
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = nrCounter
aCounter = aCounter + 1
Next
End If
s = Mid(s, posSingle + 1)
ElseIf posSingle > 0 Then
entry = Mid(s, 1, posSingle - 1)
If IsNumeric(entry) Then
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = entry
aCounter = aCounter + 1
End If
s = Mid(s, posSingle + 1)
ElseIf posGroup > 0 Then
startNr = Mid(s, 1, posGroup - 1)
endNr = Mid(s, posGroup + 1)
If IsNumeric(startNr) And IsNumeric(endNr) Then
For nrCounter = startNr To endNr
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = nrCounter
aCounter = aCounter + 1
Next
End If
s = Mid(s, posGroup + 1, Len(endNr))
Else
'What's left should be a number
entry = s
If IsNumeric(entry) Then
ReDim Preserve aNumbers(aCounter)
aNumbers(aCounter) = entry
aCounter = aCounter + 1
End If
s = ""
End If
Loop Until Len(s) = 0
ExtractNumbersFromString = aNumbers
End Function

Cindy Meister
INTER-Solutions,
Switzerlandhttp://homepage.swissonline.ch/cindymeister(last update Jun 17
2005)http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :)
Click to expand...

Hi Cindy,

I am deeply impressed! What a code! Thank you very much for your
professional help. Regrettably I am not able to integrate the
following code into your superb code:

------------------------------
Set tbl = ActiveDocument.Tables(i)
For Each oRw In ActiveDocument.Tables(i).rows
If Not oRw.Cells.Shading.BackgroundPatternColor =
wdColorAutomatic Then
oRw.Cells.Shading.BackgroundPatternColor =
wdColorGray25
End If
Next
-----------------------------------------------------

Where does this code snippet go?

Help is much appreciated. Thank you so much in advance. Again, this
is very nice of you to be so helpful. Regards, Andreas
 
C

Cindy M.

Hi Andreas-hermle,
Regrettably I am not able to integrate the
following code into your superb code:

------------------------------
Set tbl = ActiveDocument.Tables(i)
For Each oRw In ActiveDocument.Tables(i).rows
If Not oRw.Cells.Shading.BackgroundPatternColor =
wdColorAutomatic Then
oRw.Cells.Shading.BackgroundPatternColor =
wdColorGray25
End If
Next
Click to expand...

I'm not sure if Doug's reply is relevant to your question or not. But
the way I understand your original question, I believe it should
integrate like this:

For counter = LBound(aIndexes()) To UBound(aIndexes())
If aIndexes(counter) <= nrTables Then
Set tbl = ActiveDocument.Tables(aIndexes(counter))
'Rest of your code follows here
'Now clean it up
Set tbl = Nothing

The array aIndexes() carries the numbers from the InputBox; each member
of the array represents one of the numbers you specified. So we loop
through the numbers to get the table indexes: aIndexes(counter) is a
single table's index.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :)
 
A

andreas-hermle

Use:

Dim i As Long
Dim tbl As Table
Dim oRw As Row
For i = 1 To ActiveDocument.Tables.Count
    Set tbl = ActiveDocument.Tables(i)
    Select Case i
    Case 1 To 4, 11, Is > 15
        For Each oRw In tbl.Rows
            If Not oRw.Cells.Shading.BackgroundPatternColor =
wdColorAutomatic Then
                oRw.Cells.Shading.BackgroundPatternColor = wdColorGray25
            End If
        Next
    End Select
Next i

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.











Hi Cindy,

I am deeply impressed! What a code! Thank you very much for your
professional help. Regrettably I am not able to integrate the
following code into your superb code:

------------------------------
Set tbl = ActiveDocument.Tables(i)
                For Each oRw In ActiveDocument.Tables(i).rows
                     If Not oRw.Cells.Shading.BackgroundPatternColor =
wdColorAutomatic Then
                        oRw.Cells.Shading.BackgroundPatternColor =
wdColorGray25
                     End If
                Next
-----------------------------------------------------

Where does this code snippet go?

Help is much appreciated.  Thank you so much in advance. Again, this
is very nice of you to be so helpful.  Regards, Andreas- Hide quoted text -

- Show quoted text -
Click to expand...

Hi Doug,

thank you very much for your quick help. Your code is only partly
relevant to my initial question, however I can use this code for other
purposes. thank you very much for your professional help. Regards,
Andreas
 
A

andreas-hermle

Hi Andreas-hermle,



I'm not sure if Doug's reply is relevant to your question or not. But
the way I understand your original question, I believe it should
integrate like this:

    For counter = LBound(aIndexes()) To UBound(aIndexes())
        If aIndexes(counter) <= nrTables Then
            Set tbl = ActiveDocument.Tables(aIndexes(counter))
            'Rest of your code follows here
            'Now clean it up
            Set tbl = Nothing

The array aIndexes() carries the numbers from the InputBox; each member
of the array represents one of the numbers you specified. So we loop
through the numbers to get the table indexes: aIndexes(counter) is a
single table's index.

Cindy Meister
INTER-Solutions, Switzerlandhttp://homepage.swissonline.ch/cindymeister(last update Jun 17 2005)http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :)
Click to expand...


Hi cindy,

Great, it works fine. Thank you very much for your terrific and
professional help. I really appreciate it. Thanks a lot. Very nice
coding!!!!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Looping and omit certain interations using an InputBox 2
Apply-user-defined table style only to tables with no verticallymerged cells 2
Change cell shading of selected table 2
Delete table and text box in current section 2
Change alternate shading of all tables in a document by means ofInput Boxes 3
Alternate grey shading for selected rows of a table 5
Find-VBA Operation falling into an endless loop in tables 4
Apply "Space Before 18 pt" on all the paragraph immediately followingtables 2

Top