0

I would be very grateful if anybody could help me to optimize my macro. I can't see a problem in it, the most memory demanding part is setting a range into variable which consists of 18x5 cells array.

Attached is screen from Variantenter image description here

The excel files that I'm working on are 130KB and 80KB.

So it's hard for me to believe that it in fact is out of memory. Maybe I have some leak that I'm not seeing. Please look at the attached code:

Option Explicit

Function GetRangeNames(ByRef wb As Workbook) As String
  Dim cmdSet As String
  Dim nm As Object
  For Each nm In wb.Names
    If nm.Name Like Chr(42) & "info_" & Chr(42) Or _
       nm.Name Like Chr(42) & "timer_" & Chr(42) Then
        cmdSet = cmdSet & "If RangeExists(""" & nm.Name & """) Then ActiveWorkbook.Names(""" & nm.Name & """).Delete" & vbCrLf
        cmdSet = cmdSet & "ActiveWorkbook.Names.Add Name:=""" & nm.Name & """, RefersTo:=""" & nm.RefersTo & """" & vbCrLf
    End If
  Next nm
  Set nm = Nothing
  GetRangeNames = cmdSet
End Function


Sub StringExecute(s As String)
    Dim vbComp As Object
    Set vbComp = ThisWorkbook.VBProject.VBComponents.Add(1)
    vbComp.CodeModule.AddFromString _
        "Function RangeExists(R As String) As Boolean" & vbCrLf _
        & "Dim Test As Range" & vbCrLf _
        & "On Error Resume Next" & vbCrLf _
        & "Set Test = ActiveSheet.Range(R)" & vbCrLf _
        & "RangeExists = Err.Number = 0" & vbCrLf _
        & "End Function" & vbCrLf _
        & "Sub foo()" & vbCrLf _
        & s & vbCrLf _
        & "End Sub"
    Application.Run vbComp.Name & ".foo"
    ThisWorkbook.VBProject.VBComponents.Remove vbComp
End Sub


Sub prosjekt_oppdateringer()

' ------------ INIT --------------
  Application.DisplayAlerts = False
  Application.CutCopyMode = False
  Dim namesCmdSet As String
  Dim copyRange As Variant


' ------------ UPDATE LEVERANSE-DATA TABLE --------------
  Sheets("leveranse-data").Select
  If Range("Z1").Value <> "Tid etter leverandør" Then
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("tab_leveranse_data[[#Headers],[Kolonne1]]").Select
    ActiveCell.FormulaR1C1 = "OB"
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("tab_leveranse_data[[#Headers],[Kolonne1]]").Select
    ActiveCell.FormulaR1C1 = "Tid etter leverandør"
    Application.CutCopyMode = False
  End If


' ------------ UPDATE EPOST TABLE --------------
  Sheets("prosjekt-info").Select
  Range("tab_eposter").Select

  Application.Workbooks.Open _
    Filename:="!prosjekt.xlsx", _
    Local:=True

  copyRange = Range("tab_eposter").Formula2Local
  namesCmdSet = GetRangeNames(ActiveWorkbook)

  Application.CutCopyMode = False
  ActiveWindow.Close False

  StringExecute (namesCmdSet)
  namesCmdSet = ""

  Range("tab_eposter").Value = copyRange ' <--- this is a part where I get Out of memory error.

  Sheets("prosjekt-info").Select
  Range("D3").Select



' ------------ DE-INIT --------------
'  ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
  Application.CutCopyMode = False
'  Application.Quit

End Sub
Slawowid
  • 43
  • 8
  • 2
    Try to [avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code – cybernetic.nomad Apr 17 '23 at 23:47
  • It's not clear why you need to dynamically insert code into your project? – Tim Williams Apr 17 '23 at 23:50
  • @TimWilliams I'm maintaining an excel template for projects and I need a macro that will update the old project files created from older versions of the template. – Slawowid Apr 18 '23 at 00:15

1 Answers1

1

Thanks everyone for seeing my post.

I have found solution to my question: I did have formulas copied so I couldn't insert it as Values because of the equal sign in the beginning of the variant variable.

    copyRange = Range("tab_eposter").Formula2Local

The solution that works for me is:

    Range("tab_eposter").Formula2Local = copyRange

But it also doesn't work as it should so I had to use loop through every cell in range, but eventually made it.

The strange thing is that this Value / Formula did throw out Out of Memory error.

Slawowid
  • 43
  • 8