VBA "out of memory" help

[VBAhelp33]

Hi all,

I have been building some code and I am now getting this "out of memory" error. Basically I have built a userform which has list1 (lstSelector) which the user can select & remove items to listbox2 and then the user clicks go and the selected data from listbox2 is pasted into an excel worksheet.

It appears to happen to I tell my userform to paste the data in listbox2 to an excel worksheet. (Private Sub CommandButton4_Click())

Googling the error and it appears vague. It says to set ranges & objects to nothing. So I have set my worksheets to nothing but it hasn't stopped my error.

Does anything in my below code look like it cold be causing the error?



Private Sub UserForm_Initialize()

Dim sh As Worksheet
Set sh = Worksheets("Data")

Dim i As Long

For i = 3 To sh.Range("A500").End(xlUp).Row

Me.lstSelector.AddItem sh.Cells(i, 1)

Me.lstSelector.List(lstSelector.ListCount - 1, 1) = sh.Cells(i, 2)

Next i

Set sh = Nothing

End Sub

Private Sub cmdAdd_Click() 'Code to add items from listbox1 to listbox2

Dim iCtr As Long

For iCtr = 0 To Me.lstSelector.ListCount - 1

If Me.lstSelector.Selected(iCtr) = True Then

Me.ListBox2.AddItem Me.lstSelector.List(iCtr)

Me.ListBox2.List(ListBox2.ListCount - 1, 1) = Me.lstSelector.List(iCtr, 1)

End If

Next iCtr

For iCtr = Me.lstSelector.ListCount - 1 To 0 Step -1

If Me.lstSelector.Selected(iCtr) = True Then

Me.lstSelector.RemoveItem iCtr

End If

Next iCtr


End Sub


Private Sub CommandButton2_Click() 'Remove selected items from listbox2 and move them back to listbox1

Dim iCtr As Long

For iCtr = 0 To Me.ListBox2.ListCount - 1

If Me.ListBox2.Selected(iCtr) = True Then

Me.lstSelector.AddItem Me.ListBox2.List(iCtr)

Me.lstSelector.List(lstSelector.ListCount - 1, 1) = Me.ListBox2.List(iCtr, 1)

End If

Next iCtr


For iCtr = Me.ListBox2.ListCount - 1 To 0 Step -1

If Me.ListBox2.Selected(iCtr) = True Then

Me.ListBox2.RemoveItem iCtr

End If

Next iCtr

End Sub



Private Sub CommandButton3_Click() 'Remove all items in listbox2 and return them to listbox1

Dim iCtr As Long

For iCtr = 0 To Me.ListBox2.ListCount - 1

Me.lstSelector.AddItem Me.ListBox2.List(iCtr)

Me.lstSelector.List(lstSelector.ListCount - 1, 1) = Me.ListBox2.List(iCtr, 1)

Next iCtr

Me.ListBox2.Clear

End Sub



Private Sub CommandButton4_Click() 'paste selected items in listbox2 to excel worksheet

Dim i As Long

For i = 0 To Me.ListBox2.ListCount - 1

ListBox2.Selected(i) = True

Next

Dim PS As Worksheet

Set PS = Worksheets("PortfolioSummary")

For i = 0 To Me.ListBox2.ListCount - 1

If Me.ListBox2.Selected(i) = True And Me.ListBox2.List(i, 1) <> "" Then

PS.Range("E52").End(xlUp).Offset(1, 0) = Me.ListBox2.List(i, 0)

PS.Range("E52").End(xlUp).Offset(0, 1) = Me.ListBox2.List(i, 1)

Else

Me.ListBox2.Selected(i) = False

End If

Next i

Set PS = Nothing

Unload Me

End Sub

 

[VBAhelp33]

How to I edit my above post??

 

[VBAhelp33]

Private Sub UserForm_Initialize()

Dim sh As Worksheet
Set sh = Worksheets("Data")

Dim i As Long

For i = 3 To sh.Range("A500").End(xlUp).Row

Me.lstSelector.AddItem sh.Cells(i, 1)

Me.lstSelector.List(lstSelector.ListCount - 1, 1) = sh.Cells(i, 2)

Next i

Set sh = Nothing

End Sub

Private Sub cmdAdd_Click() 'Code to add items from listbox1 to listbox2

Dim iCtr As Long

For iCtr = 0 To Me.lstSelector.ListCount - 1

If Me.lstSelector.Selected(iCtr) = True Then

Me.ListBox2.AddItem Me.lstSelector.List(iCtr)

Me.ListBox2.List(ListBox2.ListCount - 1, 1) = Me.lstSelector.List(iCtr, 1)

End If

Next iCtr

For iCtr = Me.lstSelector.ListCount - 1 To 0 Step -1

If Me.lstSelector.Selected(iCtr) = True Then

Me.lstSelector.RemoveItem iCtr

End If

Next iCtr


End Sub


Private Sub CommandButton2_Click() 'Remove selected items from listbox2 and move them back to listbox1

Dim iCtr As Long

For iCtr = 0 To Me.ListBox2.ListCount - 1

If Me.ListBox2.Selected(iCtr) = True Then

Me.lstSelector.AddItem Me.ListBox2.List(iCtr)

Me.lstSelector.List(lstSelector.ListCount - 1, 1) = Me.ListBox2.List(iCtr, 1)

End If

Next iCtr


For iCtr = Me.ListBox2.ListCount - 1 To 0 Step -1

If Me.ListBox2.Selected(iCtr) = True Then

Me.ListBox2.RemoveItem iCtr

End If

Next iCtr

End Sub



Private Sub CommandButton3_Click() 'Remove all items in listbox2 and return them to listbox1

Dim iCtr As Long

For iCtr = 0 To Me.ListBox2.ListCount - 1

Me.lstSelector.AddItem Me.ListBox2.List(iCtr)

Me.lstSelector.List(lstSelector.ListCount - 1, 1) = Me.ListBox2.List(iCtr, 1)

Next iCtr

Me.ListBox2.Clear

End Sub



Private Sub CommandButton4_Click() 'paste selected items in listbox2 to excel worksheet

Dim i As Long

For i = 0 To Me.ListBox2.ListCount - 1

ListBox2.Selected(i) = True

Next

Dim PS As Worksheet

Set PS = Worksheets("Summary")

For i = 0 To Me.ListBox2.ListCount - 1

If Me.ListBox2.Selected(i) = True And Me.ListBox2.List(i, 1) <> "" Then

PS.Range("E52").End(xlUp).Offset(1, 0) = Me.ListBox2.List(i, 0)

PS.Range("E52").End(xlUp).Offset(0, 1) = Me.ListBox2.List(i, 1)

Else

Me.ListBox2.Selected(i) = False

End If

Next i

Set PS = Nothing

Unload Me

End Sub