title: Sending Selected Items to a Cell
body: <p>I am trying to get the items that I have and initiate all the separate items into its own respective cell. </p>
  
  <pre><code>With Me.selecteditems
      For i = 1 To .ListCount - 1
          If .Selected(i) Then
              found = True
              On Error Resume Next
              str = ThisWorkbook.Sheets(9).Range("A1:Cells(i, 1)")
              quantity = ThisWorkbook.Sheets(9).Range("A1:Cells(i, 2)")
              On Error GoTo 0
          End If
      Next i
  End With
  </code></pre>
  
  <p>This part of the below code, is supposed to put the items that come from the longer part of the code and put in the item, <code>str</code>, and the amount, <code>quantity</code>. I tried different ways and just recently I tried repeating how it was before, it doesn't come out that well. Also without the error it throws me:</p>
  
  <blockquote>
    <p>Application-defined or Object-defined Error</p>
  </blockquote>
  
  <p>The Whole Code:</p>
  
  <pre><code>Dim i As Long, j As Long, ii As Long
  Dim found As Boolean
  Dim str As String
  Dim message, title, defaultval As String
  Dim quantity As String
  
  
  With Me.selecteditems
      For i = 0 To .ListCount - 1
          If .Selected(i) Then
              found = True
              For ii = 0 To .ColumnCount - 1
                  If str = "" Then
                      str = .List(i, ii) &amp; vbTab
                  Else
                      If ii &lt; .ColumnCount - 1 Then
                          str = str &amp; .List(i, ii) &amp; vbTab
                      Else
                          str = str &amp; .List(i, ii)
                      End If
                  End If
              Next ii
              message = "How much" &amp; vbCrLf &amp; str &amp; "?"
              title = "Amount"
              defaultval = "1"
              quantity = InputBox(message, title, defaultval)
              str = str &amp; "  x  " &amp; quantity &amp; vbNewLine
          End If
      Next i
  End With
  
  With Me.selecteditems
      For i = 1 To .ListCount - 1
          If .Selected(i) Then
              found = True
              On Error Resume Next
              str = ThisWorkbook.Sheets(9).Range("A1:Cells(i, 1)")
              quantity = ThisWorkbook.Sheets(9).Range("A1:Cells(i, 2)")
              On Error GoTo 0
          End If
      Next i
  End With
  </code></pre>