Insert autotext based on selections in multiselect listbox

[GenuineGin]

Hello,

I am trying to insert autotext into a report based on the selections in a multiselect listbox.

The items include: Bat - Building, Bat - Tree, Badger, Otter, Dormouse etc.

Bat - Building is item(1), Bat - Tree is item(2), the rest are item(3) onwards and are all classed as 'other'.



'Insert Appropriate Criteria Table
Dim CriteriaTableRng As Range

'All
If lstPh1SppSurveyed.Selected(1) = True And lstPh1SppSurveyed.Selected(2) = True Then
If lstPh1SppSurveyed.Selected(3) = True Or lstPh1SppSurveyed.Selected(4) = True Or lstPh1SppSurveyed.Selected(5) = True Or lstPh1SppSurveyed.Selected(6) = True Or _
lstPh1SppSurveyed.Selected(7) = True Or lstPh1SppSurveyed.Selected(8) = True Or lstPh1SppSurveyed.Selected(9) = True _
Or lstPh1SppSurveyed.Selected(10) = True Or lstPh1SppSurveyed.Selected(11) = True Or lstPh1SppSurveyed.Selected(12) = True Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - All").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If
'Bat Building and Other
If lstPh1SppSurveyed.Selected(2) = False And lstPh1SppSurveyed.Selected(1) = True Then
If lstPh1SppSurveyed.Selected(3) = True Or lstPh1SppSurveyed.Selected(4) = True Or lstPh1SppSurveyed.Selected(5) = True Or _
lstPh1SppSurveyed.Selected(6) = True Or lstPh1SppSurveyed.Selected(7) = True Or lstPh1SppSurveyed.Selected(8) = True Or lstPh1SppSurveyed.Selected(9) = True _
Or lstPh1SppSurveyed.Selected(10) = True Or lstPh1SppSurveyed.Selected(11) = True Or lstPh1SppSurveyed.Selected(12) = True Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - Bat Bld & Other").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If
'Bat Tree and Other
If lstPh1SppSurveyed.Selected(1) = False And lstPh1SppSurveyed.Selected(2) = True Then
If lstPh1SppSurveyed.Selected(3) = True Or lstPh1SppSurveyed.Selected(4) = True Or lstPh1SppSurveyed.Selected(5) = True Or _
lstPh1SppSurveyed.Selected(6) = True Or lstPh1SppSurveyed.Selected(7) = True Or lstPh1SppSurveyed.Selected(8) = True Or lstPh1SppSurveyed.Selected(9) = True _
Or lstPh1SppSurveyed.Selected(10) = True Or lstPh1SppSurveyed.Selected(11) = True Or lstPh1SppSurveyed.Selected(12) = True Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - Tree & Other").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If
'Bat Building and Tree
If lstPh1SppSurveyed.Selected(1) = True And lstPh1SppSurveyed.Selected(2) = True Then
If lstPh1SppSurveyed.Selected(3) = False And lstPh1SppSurveyed.Selected(4) = False And lstPh1SppSurveyed.Selected(5) = False And lstPh1SppSurveyed.Selected(6) = False And _
lstPh1SppSurveyed.Selected(7) = False And lstPh1SppSurveyed.Selected(8) = False And lstPh1SppSurveyed.Selected(9) = False And _
lstPh1SppSurveyed.Selected(10) = False And lstPh1SppSurveyed.Selected(11) = False And lstPh1SppSurveyed.Selected(12) = False Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - Bat Bld & Tree").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If
'Bat Building Only
If lstPh1SppSurveyed.Selected(1) = True Then
If lstPh1SppSurveyed.Selected(2) = False And lstPh1SppSurveyed.Selected(3) = False And lstPh1SppSurveyed.Selected(4) = False And _
lstPh1SppSurveyed.Selected(5) = False And lstPh1SppSurveyed.Selected(6) = False And lstPh1SppSurveyed.Selected(7) = False And lstPh1SppSurveyed.Selected(8) = False And lstPh1SppSurveyed.Selected(9) = False _
Or lstPh1SppSurveyed.Selected(10) = False And lstPh1SppSurveyed.Selected(11) = False And lstPh1SppSurveyed.Selected(12) = False Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - Bat Bld").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If
'Bat Tree Only
If lstPh1SppSurveyed.Selected(2) = True Then
If lstPh1SppSurveyed.Selected(1) = False And lstPh1SppSurveyed.Selected(3) = False And lstPh1SppSurveyed.Selected(4) = False And _
lstPh1SppSurveyed.Selected(5) = False And lstPh1SppSurveyed.Selected(6) = False And lstPh1SppSurveyed.Selected(7) = False And lstPh1SppSurveyed.Selected(8) = False And lstPh1SppSurveyed.Selected(9) = False _
And lstPh1SppSurveyed.Selected(10) = False And lstPh1SppSurveyed.Selected(11) = False And lstPh1SppSurveyed.Selected(12) = False Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - Tree").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If
'Other Only
If lstPh1SppSurveyed.Selected(1) = False And lstPh1SppSurveyed.Selected(2) = False Then
If lstPh1SppSurveyed.Selected(3) = True Or lstPh1SppSurveyed.Selected(4) = True Or _
lstPh1SppSurveyed.Selected(5) = True Or lstPh1SppSurveyed.Selected(6) = True Or lstPh1SppSurveyed.Selected(7) = True Or lstPh1SppSurveyed.Selected(8) = True Or lstPh1SppSurveyed.Selected(9) = True _
Or lstPh1SppSurveyed.Selected(10) = True Or lstPh1SppSurveyed.Selected(11) = True Or lstPh1SppSurveyed.Selected(12) = True Then
Set CriteriaTableRng = ActiveDocument.Bookmarks("CriteriaTable").Range
ActiveDocument.AttachedTemplate.AutoTextEntries("Criteria Table - Other").Insert Where:=CriteriaTableRng, RichText:=True
End If
End If

The code seems to work for everything except when there is a combination including "Bat - Building" (Item(1)), then the "Bat - Building" bit supersedes everything else (I.e. Bat - Building = correct, Bat - Tree and Other = Correct, Bat - Building and Bat - Tree = Bat - Building, Bat - Building and Other = Bat - Building). My question is why?

Bit of a mind bender but I hope that makes sense...

Gin

[snb]

Sub M_snb()
For j = 1 To 12
If j = 1 Then y = 10 * Abs(lstPh1SppSurveyed.Selected(j))
If j = 2 Then y = y + 30 * Abs(lstPh1SppSurveyed.Selected(j))
If j > 2 Then y = y + 1 * Abs(lstPh1SppSurveyed.Selected(j))
Next

With ActiveDocument.AttachedTemplate
Select Case y
Case 50
.AutoTextEntries("Criteria Table - All").Insert ActiveDocument.Bookmarks("CriteriaTable").Range, RichText:=True
Case 40
.AutoTextEntries("Criteria Table - Bat Bld & Other").Insert ActiveDocument.Bookmarks("CriteriaTable").Range, RichText:=True
Case 10
.AutoTextEntries("Criteria Table - Other").Insert ActiveDocument.Bookmarks("CriteriaTable").Range, RichText:=True
-------
End Select
End With
End Sub

[gmaxey]

Gin,

Another drive by post from snb that while promising, won't work in your case. That isn't surprising because snb provides alternatives not solutions. That said, the loop and y evaluation, while wrong, is clever.

From reading your post, your listbox contains 12 items. Since snb's code will process your item 2 through 12 and you don't have a 13th item the code will crash with an unhandled error. Listbox entries are indexed starting with 0.

Furthermore I think by only other you mean any one of the remaining 10 or any combination of the other ten. Try your variation with this

Private Sub UserForm_Initialize()
Dim strArr() As String
strArr = Split("Bat - Building,Bat - Tree,A,B,C,D,E,F,G,H,I,J", ",")
With ListBox1
.List = strArr
.MultiSelect = fmMultiSelectMulti
End With
End Sub
Private Sub CommandButton1_Click()
Dim j As Long
Dim y As Long
For j = 0 To 11
If j = 0 Then y = 15 * Abs(ListBox1.Selected(j))
If j = 1 Then y = y + 30 * Abs(ListBox1.Selected(j))
If j > 1 Then y = y + 1 * Abs(ListBox1.Selected(j))
Next
MsgBox y
With ActiveDocument.AttachedTemplate
Select Case y
Case 55
MsgBox "All are selected"
Case 45
MsgBox "Bat Building and Bat Building only are selected"
Case 46 To 54
MsgBox "Bat Building, Bat Tree and one or more other selected but not all."
Case 30
MsgBox "Bat tree only selected"
Case 15
MsgBox "Bat buidling only selected"
Case 31 To 40
MsgBox "Bat Tree and other are selected"
Case 16 To 25
MsgBox "Bat building and other are selected"
Case Is <= 10
MsgBox "Other only selected"
End Select
End With
End Sub