Hello all, I have problem with 2 inside cycles. Because Excel increasing amount of used RAM each cycle and when reach max amount of usable RAM (around 1,6GB) then stops, give me a error message that there are not free RAM and I have to force shut down the Excel. All others cycles what I using in other macros working OK, only this part of code:
Code
Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
jmeno2 = ActiveSheet.Name
Dim sPath As String
sPath = "\\cesta\"
Dim lastrow As Long, x As Long
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row - 1
y = 0
yy = 0
'''''''''''''''''''''''''edited
If Worksheets("Data").Cells(1, 1) = "" Then
Call Recurse2(sPath)
Else
y = Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
End If
'''''''''''''''''''''''''
Dim i As Long
Dim test_cesta As String
Dim test_str As String
x = 2
Do While x <= lastrow
For i = 1 To y
If Mid(Worksheets(jmeno2).Cells(x, 3), InStr(1, Worksheets(jmeno2).Cells(x, 3), "+") + 1, 1) = "H" Then
test_str = Left(Worksheets(jmeno2).Cells(x, 3), InStr(1, Worksheets(jmeno2).Cells(x, 3), "+") - 1)
Else
test_str = Worksheets(jmeno2).Cells(x, 3)
End If
If InStr(1, Worksheets("Data").Cells(i, 1), test_str) <> 0 Then
test_cesta = Worksheets("Data").Cells(i, 2).Text
test1 = GetInfoFromClosedFile(Replace(Worksheets("Data").Cells(i, 2), Worksheets("Data").Cells(i, 1), ""), Worksheets("Data").Cells(i, 1), "Summary", "A1")
If IsError(test1) Then
test3 = GetInfoFromClosedFile(Replace(Worksheets("Data").Cells(i, 2), Worksheets("Data").Cells(i, 1), ""), Worksheets("Data").Cells(i, 1), "List1", "A1")
If IsError(test3) Then
Worksheets(jmeno2).Cells(x, 15) = "xxx"
Else
jmeno_listu = "List1'!$Z$7"
Worksheets(jmeno2).Cells(x, 16).FormulaLocal = "=" & "'" & _
Left(test_cesta, InStrRev(test_cesta, "\")) & "[" & _
Right(test_cesta, Len(test_cesta) - InStrRev(test_cesta, "\")) _
& "]" & jmeno_listu
Worksheets(jmeno2).Cells(x, 16).Value = Worksheets(jmeno2).Cells(x, 16).Value * 3600
If Round(Val(Worksheets(jmeno2).Cells(x, 16)), 2) <> Round(Val(Worksheets(jmeno2).Cells(x, 13)), 2) Then
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(255, 0, 0)
Else
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(0, 255, 0)
End If
End If
Else
jmeno_listu = "Summary'!$J$13"
jmeno_listu2 = "Summary'!$O$12"
Worksheets(jmeno2).Cells(x, 15).FormulaLocal = "=" & "'" & _
Left(test_cesta, InStrRev(test_cesta, "\")) & "[" & _
Right(test_cesta, Len(test_cesta) - InStrRev(test_cesta, "\")) _
& "]" & jmeno_listu
Worksheets(jmeno2).Cells(x, 15).Value = Worksheets(jmeno2).Cells(x, 15).Value
Worksheets(jmeno2).Cells(x, 16).FormulaLocal = "=" & "'" & _
Left(test_cesta, InStrRev(test_cesta, "\")) & "[" & _
Right(test_cesta, Len(test_cesta) - InStrRev(test_cesta, "\")) _
& "]" & jmeno_listu2
Worksheets(jmeno2).Cells(x, 16).Value = Worksheets(jmeno2).Cells(x, 16).Value
If Round(Val(Worksheets(jmeno2).Cells(x, 16)) * Val(Worksheets(jmeno2).Cells(x, 15)), 2) <> Round(Val(Worksheets(jmeno2).Cells(x, 13)), 2) Then
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(255, 0, 0)
Else
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(0, 255, 0)
End If
End If
DoEvents
Exit For
End If
Application.StatusBar = "Progress: " & x - 1 & " of " & lastrow - 1 & ": " & Format((x - 1) / (lastrow - 1), "0%") & " | "
DoEvents
test_str = Empty
test1 = Empty
test3 = Empty
Next i
x = x + 1
DoEvents
Application.CutCopyMode = False
ThisWorkbook.Save
Loop
x = Empty
y = Empty
yy = Empty
lastrow = Empty
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ThisWorkbook.Save
End Sub
Display More