VBA code that copies column from one sheet to another has intermittent "out of memory" error

The attached code takes user input from a drop-down list, finds the matching header in another sheet, and copies a column of data from one sheet ("Classification Values") to another ("CLASS_CHECK").

This code causes "out of memory" errors after so many uses, however.

Any ideas how I can improve my code so it doesn't run out of memory?

Thank you!

Code:


Public headerTitle As String

Private Sub Worksheet_Change(ByVal Target As Range)

    headerTitle = Range("title").Value
    Debug.Print (headerTitle)
    Call doStuffWithTable
End Sub

Public Sub doStuffWithTable()

    If (headerTitle = "Analog") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Analog").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Asic") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Asic").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Board Artifacts") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Board").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Clock") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Clock").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Connector") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Connector").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Digital") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Digital").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Discrete: Capacitor") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Capacitor").Value
        Application.EnableEvents = True
End Sub

2 answers

  • answered 2018-11-08 00:25 urdearboy

    You may have an issue with your Events as pointed out by @K.Davis. Just toggle off Events once and ensure all code that will potentially bring a change is nested inside the Event trap.

    Your code can be reduced greatly here with use of Select Case and With block. This also yields significantly better readability which will go a long way in helping you debug your code.

    Sub TableStuff()
    
    Dim CV As Worksheet
    Set CV = Sheets("Classification Values")
    
    Application.EnableEvents = False
        With Sheets("CLASS_CHECK").Range("Column")
            Select Case headerTitle
                Case "Analog"
                   .Value = CV.Range("Analog").Value
                Case "Asic"
                    .Value = CV.Range("Asic").Value
                Case "Board Artifacts"
                    .Value = CV.Range("Board").Value
                Case "Clock"
                    .Value = CV.Range("Clock").Value
                Case "Connector"
                    .Value = CV.Range("Connector").Value
                Case "Digital"
                    .Value = CV.Range("Digital").Value
                Case "Discrete: Capacitor"
                    .Value = CV.Range("Capacitor").Value
            End Select
        End With
    Application.EnableEvents = True
    
    End Sub
    

  • answered 2018-11-08 00:25 Tim Williams

    Would suggest this as one possible refactoring to remove the global variable and the repetition:

    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rngTitle As Range
        Set rngTitle = Me.Range("title")
        If Not Application.Intersect(Target, rngTitle) Is Nothing Then
            doStuffWithTable rngTitle.Value
        End If
    End Sub
    
    Public Sub doStuffWithTable(title)
        Dim rngName As String
    
        Select Case title
            Case "Analog", "Asic", "Clock", "Connector", "Digital"
                rngName = title
            Case "Board Artifacts"
                rngName = "Board"
            Case "Discrete: Capacitor"
                rngName = "Capacitor"
        End Select
    
        If Len(rngName) > 0 Then
            Application.EnableEvents = False
            ThisWorkbook.Sheets("CLASS_CHECK").Range("Column").Value = _
                ThisWorkbook.Sheets("Classification Values").Range(rngName).Value
            Application.EnableEvents = True
        End If
    
    End Sub