Insert a table in word between two tables - vba

Question

I have a word document with tables containing hyperlinks to other word documents, see image below. The word documents are catogorized into groups, i.e 1 table for each group.
My problem is that sometimes people messes around with the formatting, such as adding a newline or removing a newline between the tables(so it becomes 1,2,3,4 newlines instead of 2 as my code requires) or change the order to not be alphabetic(rare and I can live with that).
So finally to my problem, In this case I created a new document PL_xxxx and the table PL does not exist, so it should insert a new table, but with SINGLE newline between tables this get inserted inside another table instead of in between tables.
' Now move up two lines, beyond the table end
Selection.MoveUp Unit:=wdLine, Count:=2
So how can I either ensure that it is always consistence newlines between tables? Is there a way to remove all newlines between tables and then recreate them, and then do the table insert? Or can I somehow loop through all tables in documents? Or is there some other way to make sure that mistakes not like this happens?
So here is my main code:
'here we alter the docout tables
If Not searchAll(dokType) Then
Call addList(dokType, Settings.documentTypeFile)
docNumber = "01"
Else
Below is my code that seach if PL exist, which will return false in this case:
' Moves cursor to the place the given string is found, or replace it
Function searchAll(searchText As String, Optional replaceText As String = "GGG") As Boolean
'default false
searchAll = False
If Not replaceText = "GGG" Then
With ActiveDocument.Range.Find
.Text = searchText
.forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = True
.Replacement.Text = replaceText
If .Execute(Replace:=wdReplaceAll) Then
searchAll = True
End If
End With
'just searching
Else
With Selection.Find
.Text = searchText
.forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = True
If .Execute Then
searchAll = True
End If
End With
End If
End Function
Here is the code that actually figures out where to place the table and add its, and here is the problem(rewrite to loop through tables instead or modify the moveup function)
Sub addList(tableKey As String, filenameTypes As String)
Dim dict As Object
Dim addAtEnd As Boolean
Dim keyArray As Variant
Dim startSearching As Boolean
Dim element As Variant
'Dictionary with all types
Set dict = getTypes(filenameTypes)
With dict
addAtEnd = False
'extract keys into variant array
keyArray = .keys
startSearching = False
For Each element In keyArray
'looping untill we find the element we want to add
If element = tableKey Then
startSearching = True
End If
'Finding the next table after were we want to insert
If startSearching Then
If searchAll(CStr(element)) Then
addAtEnd = False
Exit For
Else
addAtEnd = True
End If
End If
Next
If addAtEnd Then
Selection.EndKey Unit:=wdStory
Else
Call HelpFunctions.moveCursorUp(CStr(element))
End If
Call addTable("UT", tableKey, .item(tableKey), Settings.docUtPath)
End With
Set dict = Nothing
End Sub
And finally the move up function which then obviously moves up to much and inside the next table.
'move cursor up
Function moveCursorUp(searchText As String)
If Not searchAll(searchText) Then
MsgBox "Failed to move cursor"
Else
'Selection.Tables(1).Select
If Selection.Information(wdWithInTable) Then
Selection.Tables(1).Range.Select
Selection.Collapse 1
' Now move up two lines, beyond the table end
Selection.MoveUp Unit:=wdLine, Count:=2
End If
'Selection.Collapse WdCollapseDirection.wdCollapseStart
End If
End Function
And here is the addtable code which basically has an empty tabley stored in a seperate file.
Function addTable(typeOfTable As String, category As String, description As String, templateFolder As String)
'Insert out table
If UCase(typeOfTable) = "UT" Then
Selection.InsertFile FileName:=templateFolder + "\Doklistut.doc", Range:="", _
ConfirmConversions:=False, link:=False, Attachment:=False
'insert inn table
ElseIf UCase(typeOfTable) = "INN" Then
Selection.InsertFile FileName:=templateFolder + "\Doklistinn.doc", Range:="", _
ConfirmConversions:=False, link:=False, Attachment:=False
Else
MsgBox "wrong argument given: either inn or ut is allowed"
Exit Function
End If
'Replace the DT with the category
If Not searchAll("DT", category) Then
MsgBox "Failed to replace category in table"
End If
'Replace the Dokumenttype with the category
If Not searchAll("Dokumenttype", description) Then
MsgBox "Failed to replace document type in table"
End If
End Function

Answer 1

So thanks to all the input I have now revised the code totally and it is now working as desired, It can probably be improved, especially the selection method.
Sub addList(tableKey As String, tableDescription As String)
Selection.EndKey Unit:=wdStory
Call addTable(tableKey, tableDescription)
Call SortTables
End Sub
Sub Deleemptylines()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub SortTables()
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim blnSwapped As Boolean
Call Deleemptylines
iMin = 1
iMax = ActiveDocument.Tables.Count - 1
Do
blnSwapped = False
For i = iMin To iMax
If ActiveDocument.Tables(i).Cell(1, 1).Range.Text > ActiveDocument.Tables(i + 1).Cell(1, 1).Range.Text Then
ActiveDocument.Tables(i).Range.Cut
ActiveDocument.Tables(i).Select
Selection.Collapse WdCollapseDirection.wdCollapseEnd
Selection.Paragraphs.Add
Selection.Paragraphs.Add
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Paste
blnSwapped = True
End If
Next i
iMax = iMax - 1
Loop Until Not blnSwapped
Call Deleemptylines
End Sub
Function addTable(category As String, description As String)
'Insert out table
Selection.InsertFile FileName:=Settings.docUtPath + "\Doklistut.doc", Range:="", _
ConfirmConversions:=False, link:=False, Attachment:=False
'Replace the DT with the category
If Not searchAll("DT", category) Then
MsgBox "Failed to replace category in table"
End If
'Replace the Dokumenttype with the category
If Not searchAll("Dokumenttype", description) Then
MsgBox "Failed to replace document type in table"
End If
End Function