Alasbabylon
02-09-2005, 02:44 PM
I have a score sheet that is used daily where a large number of names won't have a score. I copy a table from Excel into Word, sort the table, then convert it to text. I would also like to be able to delete any row that has a score of 0 )represented as ~ 00.
I've tried finding the score and deleting that row, but am not having any luck getting it to work right.
I've included a document with a table and the macro (Trivia Table).
The macro I'm using isn't very elegant, I record most of my macros. But it would sure be nice to be able to automate the rest of this task.
(I want to delete everything between the first 00 score and the last line, which should stay.)
Sub TriviaTable()
'
' TriviaTable Macro
' Macro recorded 8/4/2003 by Marci Abels
'
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Range.Relocate wdRelocateDown
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 2", SortFieldType _
:=wdSortFieldNumeric, SortOrder:=wdSortOrderDescending, FieldNumber2:= _
"Column 1", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
:=wdEnglishUS
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, _
NestedTables:=True
Selection.Fields.Unlink
Selection.Style = ActiveDocument.Styles("Factoids")
Selection.Font.Reset
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "~"
.Replacement.Text = " ~ "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
I've tried finding the score and deleting that row, but am not having any luck getting it to work right.
I've included a document with a table and the macro (Trivia Table).
The macro I'm using isn't very elegant, I record most of my macros. But it would sure be nice to be able to automate the rest of this task.
(I want to delete everything between the first 00 score and the last line, which should stay.)
Sub TriviaTable()
'
' TriviaTable Macro
' Macro recorded 8/4/2003 by Marci Abels
'
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Range.Relocate wdRelocateDown
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 2", SortFieldType _
:=wdSortFieldNumeric, SortOrder:=wdSortOrderDescending, FieldNumber2:= _
"Column 1", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
:=wdEnglishUS
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, _
NestedTables:=True
Selection.Fields.Unlink
Selection.Style = ActiveDocument.Styles("Factoids")
Selection.Font.Reset
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "~"
.Replacement.Text = " ~ "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub