I have an excel file with a form, when the form is filled correctly then an OK button can be pressed. The button function is to create a file name, copy paste a master file and a specific folder (the address is stored in a cell) and rename this file. After it, the file is opened, some cells are filled with values and is saved and closed.
Code here:
Private Sub S_START_BTN_Click()
Dim Box_No As Integer 'Box Number of the Session
Dim D As String, M As String, YE As String 'Date Elements
Dim O_LINK As String 'Directory of Master File
Dim Line As String 'Production Line
Dim COSE As String 'Shop Order Text
Dim P_Coord As String 'Row at which is the right project
Dim P_QT As Integer 'target quanityt for the box
Dim CODEX As String 'Flag for session
Dim CODEXO As String 'Flag for session Open
Dim S_Coord As String 'Row at which is the active session is
Dim SN_Open As String 'Box tag of the open session
Dim S_LINK As String 'Directory of the new file
Dim nomefile As String, nomemaster As String
'Get Data from the File
Box_No = ThisWorkbook.Sheets("SESSIONS_LOG").Range("H2").Value + 1
O_LINK = ThisWorkbook.Sheets("SESSIONS_LOG").Range("G2").Value & "" & "VERIFICATOR_MASTER.xlsm"
Line = ThisWorkbook.Sheets("SESSIONS_LOG").Range("D3").Value
'Get Date Elements
D = Format$(Day(Date), "0#")
M = Format$(Month(Date), "0#")
YE = Year(Date)
'Get Shop Order
If S_SOYN_DT.Value = True Then
COSE = "NO_SHOP_ORDER"
Else
COSE = S_SO_DT
End If
'Get the target quantity
P_Coord = "K" & ThisWorkbook.Sheets("PROJECTS_DATABASE").Range("C:C").Find(What:=S_PS_DT, LookIn:=xlValues).Row
P_QT = ThisWorkbook.Sheets("PROJECTS_DATABASE").Range(P_Coord).Value
'Make the flag and check if other boxes like this exist
CODEX = YE & M & D & "-" & Line & "-" & S_PS_DT & "-" & COSE & "-" & P_QT & "-" & Left(S_PT_DT, 1)
CODEXO = CODEX & "-" & "O"
If Not IsError(Application.Match(CODEXO, ThisWorkbook.Sheets("SESSIONS_LOG").Range("J:J"), 0)) Then
If MsgBox("Another session with same parameters is active, open it?", vbQuestion + vbYesNo, "Ready to Exit?") = vbNo Then
'There is an open session, I don't want to open it
ThisWorkbook.Sheets("SESSIONS_LOG").Range("A6:M6").Delete Shift:=xlUp
Unload Me
Else
'There is an open session, I want to open it
S_Coord = "F" & ThisWorkbook.Sheets("SESSIONS_LOG").Range("J:J").Find(What:=CODEXO, LookIn:=xlValues).Row
SN_Open = ThisWorkbook.Sheets("SESSIONS_LOG").Range(S_Coord).Value
S_LINK = ThisWorkbook.Sheets("SESSIONS_LOG").Range("G1").Value & "" & SN_Open & ".xlsm"
Workbooks.Open (S_LINK)
ThisWorkbook.Sheets("SESSIONS_LOG").Range("A6:M6").Delete Shift:=xlUp
Unload Me
End If
Else
'There is no other sessions with this tag, make a new
ThisWorkbook.Sheets("SESSIONS_LOG").Range("J6").Value = CODEXO
SN_Open = CODEX & "-" & Worksheets("SESSIONS_LOG").Range("A6").Value
ThisWorkbook.Sheets("SESSIONS_LOG").Range("F6").Value = SN_Open
S_LINK = Worksheets("SESSIONS_LOG").Range("G1").Value & "" & SN_Open & ".xlsm"
'Make new file
FileCopy O_LINK, S_LINK
Workbooks.Open (S_LINK)
nomefile = SN_Open & ".xlsm"
nomemaster = ThisWorkbook.Name
'Write variables
With Workbooks(nomefile).Sheets("VERIFICATION_MASTER_FULL")
.Range("A2").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("F4").Value 'Supplier address
.Range("J2").Formula = Date
.Range("E8").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("A6").Value 'Box Number
.Range("C8").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("D3").Value 'Line
.Range("C10").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("C4").Value 'operator ID
.Range("F8").Formula = COSE 'SO
.Range("B12").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("C4").Value 'operator ID
.Range("C12").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("C3").Value 'operator level
End With
'Close, save and unload
Workbooks(nomefile).Close SaveChanges:=True
Worksheets("SESSIONS_LOG").Range("H2").Value = Worksheets("SESSIONS_LOG").Range("H2").Value + 1
Unload Me
End If
End Sub
Unfortunately after a random times, from 1 to 40, excel gives me an error "Out of Memory". After which I lose the links in my files (which are transferred to the roaming file) and the program crashes. The file has no values, only few cells filled with numbers, no formulas and no conditional formatting of any kind. Same for the copied file, also no values, not formulas and no formatting.
What You think is causing the memory issue?
I've tried all possible Microsoft walk around but many of them are not applicable because I simply do not have formulas. PC is recent, 16GB ram, office is updated.
Thanks
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…