Out of Memory Error in VBA Code

Question

Good afternoon,

Receiving the out of memory error in my code, any suggestions to change to code?

Inputs from column A are transferred to 2 different cells.

Output 1: Concatenates all the data from column A with commas inserted - between each cell value Output 2: Concatenates all the data from column A with commas and quotes inserted - for every cell value

Thanks

Sub Inserting_Commas()
' Macro to insert commas at the end of end cell value & to convert values from rows to single column

Range("A2").Select

Dim lastRow As Long
Dim outputStr As String
Dim outputStr2 As String
Dim rownumber As Long

Sheets("Sheet1").Select
lastRow = Range("A" & Rows.Count).End(xlUp).Row

' Seperate the column A by Commas
outputStr = Range("A2")

For rownumber = 3 To lastRow
    outputStr = outputStr & "," & Range("A" & rownumber)
Next

Range("D2") = outputStr

' Seperate the Column with Quotes and Commas
Range("A2").Select

For rownumber = 2 To lastRow
    Range("B" & rownumber).Value = "''" & Range("A" & rownumber) & "'"
Next

' --------------------------------------

outputStr2 = "'" & Range("B2")

For rownumber = 3 To lastRow
    outputStr2 = outputStr2 & "," & Range("B" & rownumber)
Next

Range("D20") = outputStr2

End Sub

Answer 1

Based on your comment under @George's answer that...

this code is only a partial step. I am using the output data and extract information from a Dashboard (internal system similar to SQL). The dashboard works similar to search engines. If I copy and paste the output cell into dashboard - I can segregate the required dataset.

...there is no reason to try to store the complete output in a cell inside Excel. An Excel cell can only store 32,767 characters, so your output is going to be truncated regardless of whether building the string runs out of memory or not.

Since you don't appear to need the result inside of Excel, just write it to a text file:

Sub Inserting_Commas()
    Dim fso As Object, outFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set outFile = fso.CreateTextFile("C:\Foo\bar.txt", True) 'Replace with your own path.

    With Sheets("Sheet1")
        Dim lastRow As Long, rownumber As Long
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For rownumber = 2 To lastRow
            outFile.Write "'" & .Cells(rownumber, 1).Value & "'"
            If rownumber <> lastRow Then outFile.Write ","
        Next
    End With
End Sub