Option Explicit

Dim pStr1 As String
Dim pStr2 As String
Dim pStr3 As String
Dim pStr4 As String
Dim pStr5 As String
Dim pStr6 As String

Dim oRng As Word.Range
Private Sub UserForm_Initialize()
  Set oRng = Selection.Range
  'Assign UserForm control properties
  Me.cmdInsertLB.Enabled = False
  Me.cmdInsertCB.Enabled = False
  With Me.ListBox1
    .ColumnCount = 6
    '0 values in columns 3,4,5 hides these columns from view.
    .ColumnWidths = "80;80;0;0;0;"
  End With
  With Me.ComboBox1
    .ColumnCount = 5
    .ColumnWidths = "80;80;0;0;0"
    'Require valid entry from list
    .MatchRequired = True
    .MatchEntry = fmMatchEntryComplete
  End With
  'Call procedure that loads data from XML Source
  LoadData
lbl_Exit:
  Exit Sub
End Sub
Sub LoadData()
'Refer to the "Retrieving Information from an XML Document section _
    of the article at http://msdn.microsoft.com/en-us/library/aa468547.aspx
Dim xmlDoc As New MSXML2.DOMDocument30
  xmlDoc.validateOnParse = True
  xmlDoc.async = False
  xmlDoc.Load (Source)
  GetNodeValues xmlDoc.ChildNodes
lbl_Exit:
  Exit Sub
End Sub
Sub GetNodeValues(ByRef Nodes As MSXML2.IXMLDOMNodeList)
Dim xmlnode As MSXML2.IXMLDOMNode
  For Each xmlnode In Nodes
   If xmlnode.NodeType = NODE_TEXT Then
     'Load the nodeValues for named nodes into the ListBox and ComboBox
     Select Case xmlnode.ParentNode.nodeName
       Case "Name"
         With Me.ListBox1
           .AddItem
           .Column(0, Me.ListBox1.ListCount - 1) = xmlnode.NodeValue
         End With
         With Me.ComboBox1
           .AddItem
           .Column(0, Me.ComboBox1.ListCount - 1) = xmlnode.NodeValue
         End With
       Case "Address"
         With Me
           .ListBox1.Column(1, Me.ListBox1.ListCount - 1) = xmlnode.NodeValue
           .ComboBox1.Column(1, Me.ComboBox1.ListCount - 1) = xmlnode.NodeValue
         End With
                Case "Address1"
         With Me
           .ListBox1.Column(2, Me.ListBox1.ListCount - 1) = xmlnode.NodeValue
           .ComboBox1.Column(2, Me.ComboBox1.ListCount - 1) = xmlnode.NodeValue
         End With
       Case "Address2"
         With Me
           .ListBox1.Column(3, Me.ListBox1.ListCount - 1) = xmlnode.NodeValue
           .ComboBox1.Column(3, Me.ComboBox1.ListCount - 1) = xmlnode.NodeValue
         End With
       Case "Address3"
         With Me
           .ListBox1.Column(4, Me.ListBox1.ListCount - 1) = xmlnode.NodeValue
           .ComboBox1.Column(4, Me.ComboBox1.ListCount - 1) = xmlnode.NodeValue
         End With
       Case "Postcode"
         With Me
           .ListBox1.Column(5, Me.ListBox1.ListCount - 1) = xmlnode.NodeValue
           .ComboBox1.Column(5, Me.ComboBox1.ListCount - 1) = xmlnode.NodeValue
         End With
     End Select
   End If
   If xmlnode.HasChildNodes Then
     GetNodeValues xmlnode.ChildNodes
   End If
  Next xmlnode
lbl_Exit:
  Exit Sub
End Sub
Private Sub ComboBox1_Change()
  'Set state of command button
  If Me.ComboBox1.ListIndex <> -1 Then
    Me.cmdInsertCB.Enabled = True
  Else
    Me.cmdInsertCB.Enabled = False
  End If
lbl_Exit:
  Exit Sub
End Sub
Private Sub ListBox1_Click()
  'Set state of command button
  If Me.ListBox1.ListIndex <> -1 Then
    Me.cmdInsertLB.Enabled = True
  Else
    Me.cmdInsertLB.Enabled = False
  End If
lbl_Exit:
  Exit Sub
End Sub
Private Sub cmdInsertCB_Click()
  'Build data string
  With Me.ComboBox1
    pStr1 = .Column(0, Me.ComboBox1.ListIndex)
    pStr2 = .Column(1, Me.ComboBox1.ListIndex)
    pStr3 = .Column(2, Me.ComboBox1.ListIndex)
    pStr4 = .Column(3, Me.ComboBox1.ListIndex)
ERROR HERE OS PSTR5
    pStr5 = .Column(4, Me.ComboBox1.ListIndex)
    pStr6 = .Column(5, Me.ComboBox1.ListIndex)
  End With
  'Insert data string
  With oRng
   UserForm1.TextBox1.Value = pStr1
   UserForm1.TextBox2.Value = pStr2
   UserForm1.TextBox3.Value = pStr3
   UserForm1.TextBox4.Value = pStr4
   UserForm1.TextBox5.Value = pStr5
   UserForm1.TextBox6.Value = pStr6
    .Collapse wdCollapseEnd
    .Select
  End With
  Me.Hide
  UserForm1.Show
lbl_Exit:
  Exit Sub
End Sub
Private Sub cmdInsertLB_Click()
  With Me.ListBox1
    pStr1 = .Column(0, Me.ListBox1.ListIndex)
    pStr2 = .Column(1, Me.ListBox1.ListIndex)
    pStr3 = .Column(2, Me.ListBox1.ListIndex)
    pStr4 = .Column(3, Me.ListBox1.ListIndex)
ERROR HERE OS PSTR5
    pStr5 = .Column(4, Me.ListBox1.ListIndex)
    pStr6 = .Column(5, Me.ListBox1.ListIndex)
    End With
  With oRng
   UserForm1.TextBox1.Value = pStr1
   UserForm1.TextBox2.Value = pStr2
   UserForm1.TextBox3.Value = pStr3
   UserForm1.TextBox4.Value = pStr4
   UserForm1.TextBox5.Value = pStr5
   UserForm1.TextBox6.Value = pStr6
   .Collapse wdCollapseEnd
   .Select
  End With
  Me.Hide
lbl_Exit:
  Exit Sub
End Sub