Solved: My code start to be slow.
Hi,
pls. can somebody helm me.
I have this macro for actualize my table. In past it takes about 2-3 minutes till this macro done. Now it takes about 15-20 or more minutes.
I can not post sample of my file, only my code.
On beginning of code i turn off all other events, updates of screen and set to manual calculation so i thought, that my other tables, data in this file can not have any impact to this code. Or?
I use Office 2010 on Win XP.
Any suggestions?
thx a lot
[vba]
Sub AKTUALIZACIA_PHdata()
Dim strNewName As String
Dim LastRow As Long
Dim BunkaRiadok As Variant
Dim BunkaStlpec As Variant
Dim chyba As Variant
Dim i As Long
Dim Igor_RangeCIF As Range
Dim PH_RangeUcet As Range
Dim BunkaCIF As Variant
Dim BunkaUcet As Variant
Dim CIFexist As Variant
Dim UcetExist As Variant
Dim RiadokSumOP As Long
Dim SumPrehlAng As Long
Dim SumPrehlOP As Long
Dim Angazovanost As String
Dim OP As String
Dim v_kriz As Variant
Dim v_SankUrok As Variant
Dim v_UrokSadz As Variant
Dim v_Rating As Variant
Dim v_PopisUctu As Variant
Dim v_DruhOP As Variant
Dim v_Matka As Variant
Dim v_Loan As Variant
Dim v_rc As Variant
Dim v_ICO As Variant
Dim v_RevDate As Variant
Dim v_Seg As Variant
Dim v_SegC As Variant
Dim v_PSC As Variant
Dim v_RiskCode As Variant
Dim stlpecAng As Variant
Dim stlpecOP As Variant
Dim v_OPU As String
Dim v_Ang As Variant
Dim v_OP As Variant
Dim sumaOWO As Range
Dim SUMang As Long
Dim SUMop As Long
Dim Hladaj As Range
Dim CisloRiadkuKonca As Long
Dim ang1 As Long
Dim ang2 As Long
Dim OP1 As Long
Dim OP2 As Long
'Call ZrkadloDOprehladov
' If MsgBox("Nastav sa aktívne do PH dát", 292, "") = vbNo Then Exit Sub 'načítaj názov súboru PH dát do premennej
If MsgBox("Nastav sa aktívne do PH dát", vbYesNo + vbDefaultButton1, "NASTAV SA") = vbNo Then Exit Sub 'načítaj názov súboru PH dát do premennej
strNewName = ActiveWindow.Caption
Windows(strNewName).Activate
Range("h1").Select 'začiatok zisťovania ang. a op sumy v PH
Selection.End(xlDown).Select
ActiveCell.Offset(1, -2).Select
SUMop = ActiveCell.Value
ActiveCell.Offset(0, -1).Select
SUMang = ActiveCell.Value 'KONIEC zisťovania ang. a op sumy v PH
' Overovanie posunu stĺpcov v PH súbore
With Workbooks(strNewName).Worksheets("1")
If .Cells(1, "a").Value <> "CIF" Or .Cells(1, "b").Value <> "ACC_NUMB" _
Or .Cells(1, "y").Value <> "Risk_code" Then 'ček hlavičky či sú kde majú byť V PH
MsgBox "CIF nie je A, č. účtu nie je B alebo Risk_code nie je Y. Exit sub"
Exit Sub
End If
End With
Set Igor_RangeCIF = Workbooks(strNewName).Sheets("1").Columns("a:aa")
Set PH_RangeUcet = Workbooks(strNewName).Sheets("1").Columns("b:aa")
Windows(PrehladyNAMEVp).Activate
Sheets("vývoj").Select
Range("bb3").Select
stlpecAng = Workbooks(PrehladyNAMEVp).Worksheets("aktual").Range("af3").Value 'hľadá podľa tabuľky za prehľadmi aký je aktuálny mesiac
stlpecOP = Workbooks(PrehladyNAMEVp).Worksheets("aktual").Range("ag3").Value
Application.Calculation = xlManual
Application.MaxChange = 0.001
Application.EnableEvents = False
Application.ScreenUpdating = False
'spočítaj koľko je CIFov
With Workbooks(PrehladyNAMEVp).Worksheets("vývoj")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
If .Cells(2, "bb").Value <> "kód RIZIKA" Or .Cells(2, "c").Value <> "CIF" _
Or .Cells(2, "D").Value <> "čísloúčtu" Or .Cells(2, "bq").Value <> "PSC" Then 'Or .Cells(2, "bk").Value <> "DE" Then 'ček hlavičky či sú kde majú byť
MsgBox "Stlpce posun, KRIZ - BB, cif - C, č.účt.-D, PSC - BQ. Exit sub"
Exit Sub
End If
End With
' If MsgBox("Nastav sa aktívne do PH dát", vbYesNo + vbDefaultButton1, "NASTAV SA") = vbNo Then Exit Sub 'načítaj názov súboru PH dát do premennej
If MsgBox("Angažovanosť bude podla C3 z PIV ALL:" & Range(stlpecAng & "2").Value & "(" & stlpecAng & ")" & " OP budu:" & _
Range(stlpecOP & "2").Value & "(" & stlpecOP & ")" & "OK?", vbYesNo + vbDefaultButton1, "NASTAV SA") = vbNo Then GoTo Exits
On Error Resume Next
BunkaRiadok = ActiveCell.Row
BunkaStlpec = ActiveCell.Column
'ček či ide aktualizovať správnu ang. a op -----------------------
' ------------------------------- ***************************** 'začiatok aktualizácie
For i = 4 To LastRow
On Error GoTo dalsi
ActiveCell.Offset(1, 0).Select
BunkaCIF = Cells(ActiveCell.Row, "C").Value
BunkaUcet = Cells(ActiveCell.Row, "D").Value
On Error GoTo dalsi
CIFexist = Application.VLookup(BunkaCIF, Igor_RangeCIF, 1, 0)
UcetExist = Application.VLookup(BunkaUcet, PH_RangeUcet, 1, 0)
If IsError(CIFexist) Then GoTo dalsi
If BunkaCIF = 0 Then GoTo dalsi
'na cif
v_kriz = Application.VLookup(BunkaCIF, Igor_RangeCIF, 7, 0)
v_Rating = Trim(Application.VLookup(BunkaCIF, Igor_RangeCIF, 16, 0))
v_DruhOP = Trim(Application.VLookup(BunkaCIF, Igor_RangeCIF, 10, 0))
v_PSC = Application.VLookup(BunkaCIF, Igor_RangeCIF, 23, 0)
v_RiskCode = Application.VLookup(BunkaCIF, Igor_RangeCIF, 25, 0)
v_OPU = Application.VLookup(BunkaCIF, Igor_RangeCIF, 12, 0)
v_Seg = Application.VLookup(BunkaCIF, Igor_RangeCIF, 13, 0)
v_SegC = Application.VLookup(BunkaCIF, Igor_RangeCIF, 8, 0)
v_RevDate = Application.VLookup(BunkaCIF, Igor_RangeCIF, 26, 0)
v_rc = Application.VLookup(BunkaCIF, Igor_RangeCIF, 15, 0)
v_ICO = Application.VLookup(BunkaCIF, Igor_RangeCIF, 14, 0)
'Cells(ActiveCell.Row, "BB").Value = CDec(v_kriz) 'prepíš existujúci STAV novým stavom
Cells(ActiveCell.Row, "BB").Value = v_kriz 'prepíš existujúci STAV novým stavom
Cells(ActiveCell.Row, "AX").Value = v_Rating
Cells(ActiveCell.Row, "BL").Value = v_DruhOP
Cells(ActiveCell.Row, "BQ").Value = v_PSC
Cells(ActiveCell.Row, "BC").Value = v_OPU
' If v_Seg = "P" Then v_Seg = "R"
Cells(ActiveCell.Row, "BD").Value = v_Seg
Cells(ActiveCell.Row, "BE").Value = v_SegC
If v_RevDate <> 0 Then
Cells(ActiveCell.Row, "BS").Value = v_RevDate
End If
BEZrcICO:
If v_RiskCode <> "" Then
Cells(ActiveCell.Row, "j").Value = v_RiskCode
Else
Cells(ActiveCell.Row, "j").ClearContents
End If
'na účet
If IsError(UcetExist) Then GoTo dalsi
v_SankUrok = Application.VLookup(BunkaUcet, PH_RangeUcet, 18, 0)
v_UrokSadz = Application.VLookup(BunkaUcet, PH_RangeUcet, 19, 0)
v_PopisUctu = Trim(Application.VLookup(BunkaUcet, PH_RangeUcet, 8, 0))
v_Matka = Application.VLookup(BunkaUcet, PH_RangeUcet, 23, 0)
v_Loan = Application.VLookup(BunkaUcet, PH_RangeUcet, 17, 0)
v_Ang = Application.VLookup(BunkaUcet, PH_RangeUcet, 4, 0)
v_OP = Application.VLookup(BunkaUcet, PH_RangeUcet, 5, 0)
v_OPU = Trim(Application.VLookup(BunkaUcet, PH_RangeUcet, 10, 0))
' Cells(ActiveCell.Row, "BB").Value = CDec(v_SankUrok) 'prepíš existujúci STAV novým stavom
Cells(ActiveCell.Row, "av").Value = v_SankUrok 'prepíš existujúci STAV novým stavom
Cells(ActiveCell.Row, "aw").Value = v_UrokSadz
Cells(ActiveCell.Row, "bj").Value = v_PopisUctu
Cells(ActiveCell.Row, "bp").Value = v_Matka
Cells(ActiveCell.Row, "f").Value = v_Loan
If (Cells(ActiveCell.Row, "e").Value <> "SHADOW" And v_OPU = "OWO") Or _
Cells(ActiveCell.Row, "e").Value = "SHADOW" Then
Cells(ActiveCell.Row, stlpecAng).Value = v_Ang '
Cells(ActiveCell.Row, stlpecOP).Value = v_OP
End If
dalsi:
If BunkaCIF = "koniec" Then GoTo koniec
Next
koniec:
Set Hladaj = Columns(3).Find("koniec")
If Not Hladaj Is Nothing Then CisloRiadkuKonca = Hladaj.Row
SumPrehlAng = Range(stlpecAng & CisloRiadkuKonca).Value
SumPrehlOP = Range(stlpecOP & CisloRiadkuKonca).Value
Exits:
Application.Calculation = xlAutomatic
Application.MaxChange = 0.001
Application.ScreenUpdating = True
Application.EnableEvents = True
If SumPrehlAng = SUMang Then
Angazovanost = "OK"
Else
Angazovanost = "zle"
End If
If SumPrehlOP = SUMop Then
OP = "OK"
Else
OP = "zle"
End If
MsgBox "Suma ang. Prehlady:" & Format(SumPrehlAng, "##,##0.00") & " Suma OP Prehlady:" _
& Format(SumPrehlOP, "##,##0.00") & vbNewLine & "Suma ang. PH: " & Format(SUMang, "##,##0.00") _
& " Suma OP PH: " & Format(SUMop, "##,##0.00") & vbNewLine & vbNewLine & "Takže je to " & vbNewLine _
& "Ang=" & Angazovanost & " OP=" & OP
' MsgBox "Aktualizácia PH databázy - done."
' -----------koniec aktualizácie 555555555555555555555555555555555555555555555555
strNewName = ""
LastRow = 0
BunkaRiadok = ""
BunkaStlpec = ""
chyba = ""
i = 0
BunkaCIF = ""
BunkaUcet = ""
CIFexist = ""
UcetExist = ""
RiadokSumOP = 0
SumPrehlAng = 0
SumPrehlOP = 0
Angazovanost = ""
OP = ""
v_kriz = ""
v_SankUrok = ""
v_UrokSadz = ""
v_Rating = ""
v_PopisUctu = ""
v_DruhOP = ""
v_Matka = ""
v_PSC = ""
stlpecAng = ""
stlpecOP = ""
v_OPU = ""
v_Ang = ""
v_OP = ""
SUMang = 0
SUMop = 0
CisloRiadkuKonca = 0
ang1 = 0
ang2 = 0
OP1 = 0
OP2 = 0
End Sub
[/vba]
