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
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