VBA: 'Not enough memory to complete action' but I feel like my code isn't using much memory

Question

So basically I get a popup whenever I run my code saying there isn't enough memory, but the error comes from two nested 30-element For loops. I don't really know how else I can adjust my code so that it uses memory. Basically, I'm just trying to shift down a filtered column and change the values in the column. Here's what my code looks like:

Sub Yes()


Dim docworkbook As Workbook
Set docworkbook = ThisWorkbook

Dim V_V As Worksheet
Set V_V = docworkbook.Sheets("V&V")


' Clear all filters
If V_V.AutoFilterMode Then
    V_V.AutoFilter.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If

' Get document number and revision number

Dim DocNum As Integer
Dim DocName As String

'DocName = InputBox("Enter full document name you revised (without Rev. #)")
'DocNum = InputBox("Enter Rev. # (Enter '0' if no revision number listed or if written as Rev. - )")
DocName = "SER-923961"
DocNum = 2


' Filters for docs with the same Rev. # as ThemeColor updated doc


If DocNum > 0 Then
    Range("F2:F99999").AutoFilter Field:=1, Criteria1:="=*" & DocName & " " & "Rev. " & DocNum & "*"

ElseIf DocNum < 1 Then
    Range("F2:F99999").AutoFilter Field:=1, Criteria1:="=*" & DocName & " " & "Rev. -" & "*"

End If



' Filters for docs with Rev. # of 0 and does not include "Rev. -"

' Checks if all cells have been filtered (Selects first  visible cell, checks if blank)
With V_V.AutoFilter.Range
    Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With


Dim FirstCell As Range
Set FirstCell = ActiveCell


' If the cell is empty, clear filters and filter for doc name with no 'Rev. -')

If IsEmpty(FirstCell.Value) = True Then


    Range("F2:F99999").AutoFilter Field:=1, Criteria1:="=*" & DocName & "*"

    Dim Cell As Range

    For Each Cell In Range("F3:F99999")
        If InStr(1, Cell, "Rev.") Then
            Cell.EntireRow.Hidden = True
        End If
    Next

End If



' Filter for only MHSS requirements

' This step selects the first unhidden cell under the MHSS column
With V_V.AutoFilter.Range
    Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With

ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate

Dim MHSS_First As Range
Set MHSS_First = ActiveCell


' This step creates 3 arrays that store MHSS numbers, compliance form claim responses (as Y, N, or blank), and DND validation responses (as Y, N, or blank)
Dim i As Integer

Dim MHSS_Array(999) As String
Dim Comp_Claim_Array(999) As String
Dim DND_Val_Array(999) As String


For i = 1 To 999

    MHSS_Array(i) = MHSS_First.Offset(rowOffset:=(i - 1), columnOffset:=0).Value
    Comp_Claim_Array(i) = MHSS_First.Offset(rowOffset:=(i - 1), columnOffset:=-4).Value
    DND_Val_Array(i) = MHSS_First.Offset(rowOffset:=(i - 1), columnOffset:=-5).Value

    Next i


' This finds the newest revision in the database

'Dim Doc_ID As Range
'Dim Highest_Rev As Integer
'Highest_Rev = -1
'Counter = DocNum
'
'
'
'Do While Highest_Rev < 0
'
'
'' Clear all filters
'If V_V.AutoFilterMode Then
'    V_V.AutoFilter.ShowAllData
'    ActiveSheet.AutoFilterMode = False
'End If
'
'
'    Range("F2:F99999").AutoFilter Field:=1, Criteria1:="=*" & DocName & " " & "Rev. " & Counter + 1 & "*"
'
'    With V_V.AutoFilter.Range
'      Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
'    End With
'
'
'    Set Doc_ID = ActiveCell
'
'    If IsEmpty(Doc_ID) = True Then
'        Highest_Rev = Counter
'    End If
'
'
'
'    DocNum = DocNum + 1
'
'Loop




' This step writes Y to future revisions' comp. claims if Y was written for the newest revision, and
' Y to future revisions' DND validations if Y was written for the current revision

'Highest_Rev = 10
'For rev = DocNum + 1 To Highest_Rev
rev = 3

' Clear filters
    If V_V.AutoFilterMode Then
    V_V.AutoFilter.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If

    ' Find next revision after edited one
    Range("F2:F99999").AutoFilter Field:=1, Criteria1:="=*" & DocName & " " & "Rev. " & rev & "*"


        ' Again, this selects the first unhidden cell under the MHSS column for the new revision
        With V_V.AutoFilter.Range
        Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
        End With

        ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate

        Dim MHSS_First2 As Range
        Set MHSS_First2 = ActiveCell



        ' Loops through MHSS array strings (M) to change columns B & C to each value in MHSS_Array by
        ' checking if each cell in the new revision (newrow) equals the MHSS_Array string
        Dim Shift As Range

        For M = 1 To 30

        Set CheckCell = MHSS_First2

            For newrow = 0 To 30


                ' Goes down list of MHSSs, if the MHSS array contains a MHSS number and it's equal to the cell
                ' being checked in the newer revision, all Y's in columns B and C for the original MHSS will
                ' be transferred to the newer revision
                Shift = CheckCell.Offset(rowOffset:=newrow, columnOffset:=0)




'                If IsEmpty(MHSS_Array(M)) = False And MHSS_Array(M) = CheckCell Then
'
'                   CheckCell.Offset(rowOffset:=0, columnOffset:=-4).Value = Comp_Claim_Array(M)
'
'                End If

            Next newrow
        Next M






'    Next rev







End Sub

Answer 1

Hmm the first thing that you might need to do there is to avoid setting a static range of greater than the number of data that you need.

Try initializing your ranges dynamically or initialize it based on the number of data that you have.

Try changing first all these line of code.

Range("F2:F99999").AutoFilter Field:=1, Criteria1:="=*" & DocName & "*"

into this:

 Range("F2:F" & Cells(Rows.Count, 6).End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=*" & DocName & "*"

To explain this: Cells(Rows.Count, 6).End(xlUp).Row will return a value based on the number of used cells in that certain column. On this case you are referring to Column F which is 6.