I have a problem with a macro in Excel. Here the code. There are actually quite a few subs that are I am not reporting for a matter of space. However, the most important one is attached.
Sub randomdata_generator()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FromProducts As Integer
Dim ToProducts As Integer
Dim StepProducts As Integer
Dim FromStations As Integer
Dim ToStations As Integer
Dim StepStations As Integer
FromProducts = Range("G1").Value
ToProducts = Range("I1").Value
StepProducts = Range("K1").Value
FromStations = Range("G2").Value
ToStations = Range("I2").Value
StepStations = Range("K2").Value
For h1 = FromProducts To ToProducts Step StepProducts
For h2 = FromStations To ToStations Step StepStations
Index = 0
For xx1 = 1 To 17 Step 1 'NC
x1 = h1
x2 = h2
Range("B1").Value = x1
D = Application.WorksheetFunction.Round(x1 * 0.1, 0)
E = Application.WorksheetFunction.Round(x1 * 0.2, 0)
BAEG = Application.WorksheetFunction.Round(x1 * 0.35, 0)
For xx2 = 1 To 5 Step 1
If x2 >= x1 Then GoTo prossimo
Range("B2").Value = x2
Range("B4").Value = 20 * x2 'D
For x3 = 1 To 5 'NI
Range("B3").Value = x3
If x3 > 1 Then
q = 3
Else
q = 1
End If
For g = 1 To q
x5 = 1
Range("B5").Value = x5
s = E
For i = 0 To s - 1
Range("A25").Offset(0, D + i).Value = 0.3
Range("A28").Offset(0, D + i).Value = 0.2
Range("A46").Offset(0, D + i).Value = 0.009
Next
Next
Next
Next
Next
Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
This is the part of the code that saves the new file that has been generated.
Sub salvanuovo()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wbkCurrent As Workbook
Index = Index + 1
If Index Mod 200 = 0 Then
newHour = Hour(Now())
newMinute = Minute(Now()) + 1
newSecond = Second(Now()) + 30
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
DoEvents
End If
ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm" 'example: "C:\Users\lucag\Desktop\randomdata_generator_alternativa\Dati(" & Index & ").xlsm"
Workbooks.Open Filename:=ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm"
Workbooks("Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm").Activate
Sheets("Foglio1").Select
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks("Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsx").Close
Kill (ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm")
Set wbkCurrent = ActiveWorkbook
wbkCurrent.Activate
Set wbkCurrent = Nothing
End Sub
The following image shows the issue. The memory keeps loading until Excel crashes. Any hint on how to solve this problem. enter image description here
There is no .Copy nor .Paste just some .Value assigned
Selection.ClearContents
Range("A12").Select