VBA Code - Out of memory error

ferocious12 · Mar 14, 2020

Hi - I am using the following code to fill an spreadsheet through a userform. I am getting "out of memory" error with every click. Any help? Thanks

Code:

Dim iRow As Long


Private Sub cmdOverwriteData_Click()

Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("DataSheet")


'find first empty row in database
'lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

With ws
  .Unprotect Password:="password"
  .Cells(iRow, 1).Value = cmbMonth1.Value
  .Cells(iRow, 2).Value = cmbStaff.Value
  .Cells(iRow, 3).Value = cmbType1.Value
  .Cells(iRow, 4).Value = cmbSubType.Value
  .Cells(iRow, 5).Value = cmbItemCode.Value

  .Cells(iRow, 6).Value = cmbDescription.Value
  .Cells(iRow, 7).Value = cmbUnit.Value
  .Cells(iRow, 8).Value = cmbQuantity.Value
  .Cells(iRow, 9).Value = cmbBatch.Value
  .Cells(iRow, 10).Value = cmbExpiry.Value
  .Cells(iRow, 11).Value = cmbLocation.Value
   
  .Cells(iRow, 12).Value = Application.UserName
  .Cells(iRow, 13).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
  .Protect Password:="password"
End With
MsgBox ("Completed")
Unload Me



End Sub



Private Sub MultiPage1_Change()

End Sub

Private Sub UserForm_Initialize()
Dim rngMonth, rngStaff, rngType, rngSubType, rngItemCode As Range

Dim ws As Worksheet
Set ws = Worksheets("LookupLists")

For Each rngMonth In ws.Range("Month")
Me.cmbMonth1.AddItem rngMonth.Value
Next rngMonth

For Each rngStaff In ws.Range("Staff")
Me.cmbStaff.AddItem rngStaff.Value
Next rngStaff


For Each rngType In ws.Range("Type")
Me.cmbType1.AddItem rngType.Value
Next rngType

For Each rngSubType In ws.Range("SubType")
Me.cmbSubType.AddItem rngSubType.Value
Next rngSubType

For Each rngItemCode In ws.Range("ItemCode")
Me.cmbItemCode.AddItem rngItemCode.Value
Next rngItemCode



'*******2ndPage********
Dim rngDescription, rngUnit, rngQuantity, rngBatch, rngExpiry, rngLocation As Range

For Each rngDescription In ws.Range("Description")
Me.cmbDescription.AddItem rngDescription.Value
Next rngDescription


For Each rngUnit In ws.Range("Unit")
Me.cmbUnit.AddItem rngUnit.Value
Next rngUnit

For Each rngQuantity In ws.Range("Quantity")
Me.cmbQuantity.AddItem rngQuantity.Value
Next rngQuantity


For Each rngBatch In ws.Range("Batch")
Me.cmbBatch.AddItem rngBatch.Value
Next rngBatch

For Each rngExpiry In ws.Range("Expiry")
Me.cmbExpiry.AddItem rngExpiry.Value
Next rngExpiry

For Each rngLocation In ws.Range("Location")
Me.cmbLocation.AddItem rngLocation.Value
Next rngLocation



End Sub
Private Sub cmdEditExistingRow_Click()
Dim ws As Worksheet

iRow = InputBox("Which row would you like to amend?")

Set ws = Worksheets("DataSheet")
With ws
  .Unprotect Password:="password"
  cmbMonth1.Value = .Cells(iRow, 1).Value
  cmbStaff.Value = .Cells(iRow, 2).Value
  cmbType1.Value = .Cells(iRow, 3).Value
  cmbSubType.Value = .Cells(iRow, 4).Value
  cmbItemCode.Value = .Cells(iRow, 5).Value

  cmbDescription.Value = .Cells(iRow, 6).Value
  cmbUnit.Value = .Cells(iRow, 7).Value
  cmbQuantity.Value = .Cells(iRow, 8).Value
  cmbBatch.Value = .Cells(iRow, 9).Value
  cmbExpiry.Value = .Cells(iRow, 10).Value
  cmbLocation.Value = .Cells(iRow, 11).Value
   
  .Cells(iRow, 12).Value = Application.UserName
  .Cells(iRow, 13).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
  .Protect Password:="password"
cmdAdd.Enabled = False
cmdClear.Enabled = False

End With


End Sub
Private Sub cmdAdd_Click()

Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("DataSheet")

'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

With ws
  .Unprotect Password:="password"
  .Cells(lRow, 1).Value = cmbMonth1.Value
  .Cells(lRow, 2).Value = cmbStaff.Value
  .Cells(lRow, 3).Value = cmbType1.Value
  .Cells(lRow, 4).Value = cmbSubType.Value
  .Cells(lRow, 5).Value = cmbItemCode.Value

  .Cells(lRow, 6).Value = cmbDescription.Value
  .Cells(lRow, 7).Value = cmbUnit.Value
  .Cells(lRow, 8).Value = cmbQuantity.Value
  .Cells(lRow, 9).Value = cmbBatch.Value
  .Cells(lRow, 10).Value = cmbExpiry.Value
  .Cells(lRow, 11).Value = cmbLocation.Value

  .Cells(lRow, 12).Value = Application.UserName
  .Cells(lRow, 13).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")

  .Protect Password:="password"
End With
MsgBox ("Completed")
Unload Me

End Sub
Private Sub cmdClear_Click()

Dim ws As Worksheet
Set ws = Worksheets("DataSheet")
With ws
  .Unprotect Password:="password"
  cmbMonth1.Value = Null
  cmbStaff.Value = Null
  cmbType1.Value = Null
  cmbSubType.Value = Null
  cmbItemCode.Value = Null

  cmbDescription.Value = Null
  cmbUnit.Value = Null
  cmbQuantity.Value = Null
  cmbBatch.Value = Null
  cmbExpiry.Value = Null
  cmbLocation.Value = Null

  .Protect Password:="password"

End With
End Sub

VBA Code - Out of memory error

ferocious12

Member