[RESOLVED] Memory Problem in VBA

[vikasbhandari2]

Hello Experts,

I need your help here :

I am creating a VBA Application where in I have to pick data from Excel and then I have to transfer the data in a Powerpoint's Chart Object. My excel file has six different groups. Each group has nine slides and each slide has three Graphs. Each Graph has further three values. Whenever I run my function, it enters the values till fourth group but as it comes to the fifth group, its memory gets full and my computer hangs. Is there any way that I can free up my memory?????? Or I can increase my memory within my application if needed???? Any help would be appreciated...

Thanks,Vikas Bhandari

[Dnereb]

To help you it's neccesary to read the code in your problematic function to spot the cause of the problem.

[vikasbhandari2]

Thanks for the Reply! Here is the code.

Dim oshape As PowerPoint.Shape          ' Stores Powerpoint objects
Dim ofile As PowerPoint.Presentation    'Powerpoint Presentation object
Dim pptApp As PowerPoint.Application    'Powerpoint application object
Dim oGraph As Graph.Chart
Dim rnge As Long
Dim fir(27) As Integer
Dim i As Integer
Dim objs(6, 27) As Integer
Dim slds(6, 9) As Integer
Dim cols(6, 3) As String 'we need to make \it two dimensiol for future reference
Dim j As Integer
Dim k As Integer
Dim xlwrk As Excel.Workbook
Dim ppt As Object
Dim ppt1 As String
Dim mon(12) As String
Dim newRan As Range
mon(1) = "A"
mon(2) = "B"
mon(3) = "C"
mon(4) = "D"
mon(5) = "E"
mon(6) = "F"
mon(7) = "G"
mon(8) = "H"
mon(9) = "I"
mon(10) = "J"
mon(11) = "K"
mon(12) = "L"
 
 
 
slds(1, 1) = 16
slds(1, 2) = 17
slds(1, 3) = 18
slds(1, 4) = 21
slds(1, 5) = 22
slds(1, 6) = 23
slds(1, 7) = 24
slds(1, 8) = 25
slds(1, 9) = 26
 
 
slds(2, 1) = 27
slds(2, 2) = 28
slds(2, 3) = 29
slds(2, 4) = 32
slds(2, 5) = 33
slds(2, 6) = 34
slds(2, 7) = 35
slds(2, 8) = 36
slds(2, 9) = 37
 
 
slds(3, 1) = 38
slds(3, 2) = 39
slds(3, 3) = 40
slds(3, 4) = 43
slds(3, 5) = 44
slds(3, 6) = 45
slds(3, 7) = 46
slds(3, 8) = 47
slds(3, 9) = 48
 
 
slds(4, 1) = 49
slds(4, 2) = 50
slds(4, 3) = 51
slds(4, 4) = 54
slds(4, 5) = 55
slds(4, 6) = 56
slds(4, 7) = 57
slds(4, 8) = 58
slds(4, 9) = 59
 
 
slds(5, 1) = 60
slds(5, 2) = 61
slds(5, 3) = 62
slds(5, 4) = 65
slds(5, 5) = 66
slds(5, 6) = 67
slds(5, 7) = 68
slds(5, 8) = 69
slds(5, 9) = 70
 
 
slds(6, 1) = 71
slds(6, 2) = 72
slds(6, 3) = 73
slds(6, 4) = 76
slds(6, 5) = 77
slds(6, 6) = 78
slds(6, 7) = 79
slds(6, 8) = 80
slds(6, 9) = 81
    
 
 
 
objs(1, 1) = 12
objs(1, 2) = 13
objs(1, 3) = 10
objs(1, 4) = 11
objs(1, 5) = 3
objs(1, 6) = 7
objs(1, 7) = 7
objs(1, 8) = 11
objs(1, 9) = 3
objs(1, 10) = 6
objs(1, 11) = 10
objs(1, 12) = 0
objs(1, 13) = 14
objs(1, 14) = 8
objs(1, 15) = 12
objs(1, 16) = 13
objs(1, 17) = 7
objs(1, 18) = 12
objs(1, 19) = 16
objs(1, 20) = 7
objs(1, 21) = 3
objs(1, 22) = 6
objs(1, 23) = 8
objs(1, 24) = 16
objs(1, 25) = 14
objs(1, 26) = 10
objs(1, 27) = 0
 
 
 
objs(2, 1) = 19
objs(2, 2) = 3
objs(2, 3) = 11
objs(2, 4) = 11
objs(2, 5) = 3
objs(2, 6) = 7
objs(2, 7) = 7
objs(2, 8) = 12
objs(2, 9) = 3
objs(2, 10) = 10
objs(2, 11) = 6
objs(2, 12) = 0
objs(2, 13) = 3
objs(2, 14) = 9
objs(2, 15) = 13
objs(2, 16) = 4
objs(2, 17) = 5
objs(2, 18) = 13
objs(2, 19) = 4
objs(2, 20) = 7
objs(2, 21) = 14
objs(2, 22) = 3
objs(2, 23) = 7
objs(2, 24) = 13
objs(2, 25) = 13
objs(2, 26) = 9
objs(2, 27) = 0
 
 
 
objs(3, 1) = 19
objs(3, 2) = 3
objs(3, 3) = 11
objs(3, 4) = 11
objs(3, 5) = 3
objs(3, 6) = 7
objs(3, 7) = 7
objs(3, 8) = 12
objs(3, 9) = 3
objs(3, 10) = 10
objs(3, 11) = 6
objs(3, 12) = 0
objs(3, 13) = 3
objs(3, 14) = 9
objs(3, 15) = 13
objs(3, 16) = 4
objs(3, 17) = 5
objs(3, 18) = 13
objs(3, 19) = 4
objs(3, 20) = 7
objs(3, 21) = 14
objs(3, 22) = 3
objs(3, 23) = 7
objs(3, 24) = 13
objs(3, 25) = 14
objs(3, 26) = 10
objs(3, 27) = 0
 
 
 
objs(4, 1) = 19
objs(4, 2) = 3
objs(4, 3) = 11
objs(4, 4) = 14
objs(4, 5) = 4
objs(4, 6) = 9
objs(4, 7) = 7
objs(4, 8) = 12
objs(4, 9) = 3
objs(4, 10) = 10
objs(4, 11) = 6
objs(4, 12) = 0
objs(4, 13) = 3
objs(4, 14) = 9
objs(4, 15) = 13
objs(4, 16) = 4
objs(4, 17) = 5
objs(4, 18) = 13
objs(4, 19) = 4
objs(4, 20) = 7
objs(4, 21) = 14
objs(4, 22) = 3
objs(4, 23) = 7
objs(4, 24) = 13
objs(4, 25) = 14
objs(4, 26) = 10
objs(4, 27) = 0
 
 
 
objs(5, 1) = 18
objs(5, 2) = 19
objs(5, 3) = 10
objs(5, 4) = 14
objs(5, 5) = 4
objs(5, 6) = 9
objs(5, 7) = 7
objs(5, 8) = 12
objs(5, 9) = 3
objs(5, 10) = 10
objs(5, 11) = 6
objs(5, 12) = 0
objs(5, 13) = 3
objs(5, 14) = 9
objs(5, 15) = 13
objs(5, 16) = 4
objs(5, 17) = 5
objs(5, 18) = 13
objs(5, 19) = 4
objs(5, 20) = 7
objs(5, 21) = 14
objs(5, 22) = 3
objs(5, 23) = 7
objs(5, 24) = 13
objs(5, 25) = 14
objs(5, 26) = 10
objs(5, 27) = 0
 
 
 
 
objs(6, 1) = 18
objs(6, 2) = 19
objs(6, 3) = 10
objs(6, 4) = 14
objs(6, 5) = 4
objs(6, 6) = 9
objs(6, 7) = 7
objs(6, 8) = 12
objs(6, 9) = 3
objs(6, 10) = 10
objs(6, 11) = 6
objs(6, 12) = 0
objs(6, 13) = 3
objs(6, 14) = 9
objs(6, 15) = 13
objs(6, 16) = 4
objs(6, 17) = 5
objs(6, 18) = 13
objs(6, 19) = 4
objs(6, 20) = 7
objs(6, 21) = 14
objs(6, 22) = 3
objs(6, 23) = 7
objs(6, 24) = 13
objs(6, 25) = 14
objs(6, 26) = 10
objs(6, 27) = 0
 
cols(1, 1) = "B"
cols(1, 2) = "D"
cols(1, 3) = "F"
 
cols(2, 1) = "I"
cols(2, 2) = "K"
cols(2, 3) = "M"
 
cols(3, 1) = "P"
cols(3, 2) = "R"
cols(3, 3) = "T"
 
cols(4, 1) = "W"
cols(4, 2) = "Y"
cols(4, 3) = "AA"
 
cols(5, 1) = "AD"
cols(5, 2) = "AF"
cols(5, 3) = "AH"
 
cols(6, 1) = "AK"
cols(6, 2) = "AM"
cols(6, 3) = "AO"
 
fir(1) = 2
fir(2) = 2
fir(3) = 3
fir(4) = 1
fir(5) = 1
fir(6) = 1
fir(7) = 1
fir(8) = 3
fir(9) = 1
fir(10) = 4
fir(11) = 4
fir(12) = 0
fir(13) = 1
fir(14) = 1
fir(15) = 1
fir(16) = 1
fir(17) = 1
fir(18) = 1
fir(19) = 3
fir(20) = 3
fir(21) = 3
fir(22) = 1
fir(23) = 1
fir(24) = 1
fir(25) = 2
fir(26) = 2
fir(27) = 0
 
Dim rowArr(9) As Integer
rowArr(1) = 3
rowArr(2) = 8
rowArr(3) = 12
rowArr(4) = 17
rowArr(5) = 24
rowArr(6) = 27
rowArr(7) = 30
rowArr(8) = 34
rowArr(9) = 37
 
Dim objCoun As Integer ' this is a counter for increasing Object's Value
Dim coun As Integer
Dim mo As Integer
objCoun = 1
mo = InputBox("Enter The Month for which you want to update the presentation")
If mo = Sheet3.Range("A1").Value Then
Set xlwrk = ActiveWorkbook
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
Set ofile = pptApp.Presentations.Open(ThisWorkbook.Path & "\2006 Citigroup KPI1.ppt")
Dim grp As Integer
Sheets("Sheet2").Select
        For grp = 1 To 1
        'MsgBox ("Startng " & grp)
        objCoun = 1
        coun = 1
  
    For i = 1 To 9
Dim bool As Boolean
        For j = 1 To 3
        coun = rowArr(i)
        
               If fir(objCoun) > 0 Then
                
                bool = True
                k = 1
                For k = 1 To fir(objCoun)
                ofile.Slides(slds(grp, i)).Select
                Set oshape = ofile.Slides(slds(grp, i)).Shapes("object " & objs(grp, objCoun))
                Set oGraph = oshape.OLEFormat.Object
                Sheet2.Range(cols(grp, j) & coun).Select
                rnge = ActiveCell.Value
                    If (i = 7 And bool) Or (i = 3 And bool) Then
                    bool = False
                    k = k + 1
                    End If
                    If i <> 7 And i <> 3 And fir(objCoun) = 1 Then
                    k = k + 1
                    End If
                    coun = coun + 1
                
                oGraph.Application.DataSheet.Range(mon(mo) & k).Value = rnge 'xlwrk.Worksheets("Sheet2").Range(cols(grp, j) & coun) 'rnge
               'oGraph.Application.DataSheet.Cells(mo, k).Value = rnge 
               oGraph.Application.Update
               pptApp.ActiveWindow.Selection.Unselect
 
               Set oshape = Nothing
               Set oGraph = Nothing
                Next
            End If
        objCoun = objCoun + 1
        Next
            
    Next
   Next
MsgBox ("done")
Else
           MsgBox "Please import the data for correct month"
End If
End Sub

[Hack]

Excel VBA question moved to Office Development

[vikasbhandari2]

Can some one plz plz look into this once...i am all blocked for the time...

Thanks,Vikas

[RobDog888]

What about adding a DoEvents in your inner loop?

[vikasbhandari2]

dont know much bout it...trying it though....any other thoughts????

[vikasbhandari2]

Hey Rob,

i dont know much about it...can you please explain it a little bit about how to use Do Events??? I never used it (

Thanks in advance....you are helping a lot )

[Al42]

For k = 1 To fir(objCoun)
DoEvents

[RobDog888]

Well your doing allot of selecting and other operations so not much to reduce there.

[vikasbhandari2]

Hello Rob,

I tried to find information about DoEvent. I found that DoEvents is for holding our code for some time and letting other events run....Am I right???

In my program, I dont want to stop, rather I want to create the code in such a way so that Memory doesnt get consume at such a higher rate and even if its consuming?? How can I free that memory??

Thanks,
Vikas Bhandari

[Static]

are u sure its hanging from memory?

does it error and say "Out of memory"

run the task manager and check your memory...
unless your Harddrive is almost full or u have your swapfile set small.. I doubt thats the reason.

[RobDog888]

What DoEvents does is allow some of the CPU resources to be availible for other tasks and screen updating/painting etc. So it makes your app more fluid in motion and less locked from the cpu being pegged and such. It doesnt stop the processing of your code at all.

[vikasbhandari2]

Hey Rob/Static,

I will specify the prob in detail here :

When I run my Macro for six groups, it works fine for almost 3-1/2 group items, but as soon as I reach to the end of fourth group...it becomes very slow...

I have around 30 GB Free in my Hard Disk. My Pagefile Memory is set to around 1 GB. When I open my Task Manager at this point, my pagefile memory shows full and it gets hanged. Sometimes, my macro also shows the error and when I debug then it shows the yellow line on :

Set oGraph = oshape.OLEFormat.Object

...please note that error is not because of Coding problem...I think I am not able to get the right point to vanish the objects because my powerpoints has around 150 Graphs in total which I need to update.

Any Idea???
Thanks,Vikas

[RobDog888]

Debug your code by placing a breakpoint on your outter main for next loop. and then on the third iteration step through it by pressing F8. See there must be some issue or error that is causing it to hang. Tha is pegging the cpu since its probably waiting for a response or something.

[vikasbhandari2]

Hmmmm..okay!!! I will try it once again....anyways, can you please check it once and suggest me if I have closed the oshape and ograph object at the right place or not??

I feel that I am not able to judge where should I close the Objects as well....

Any Idea??

Regards,
Vikas

[RobDog888]

Depending on what your doing, it looks like its in the right loop.

[Al42]

Set oshape = Nothing
               Set oGraph = Nothing

Try reversing these two lines. Once you destroy oshape, what is oGraph? I don't think this will solve your problem - you may just need more memory than you have (probably a l ot more if you have 150 graphs and they're large and complex), causing the program to slow WAY down as it uses swapfile as memory.

[Static]

and for fun.. up the swapfile to 2GB.. jus to see what happens

[vikasbhandari2]

thnx for ur suggestion, i will work on ur suggestions, will tell u tmrw about the results..

Thanks,Vikas

[vikasbhandari2]

Hello Experts!

I have noticed one more thing at the time of running this Macro. When I open Window Task Manager I can See there are lot of times Graph.exe file is running. When I end task all the files it works fine. Is there any function or code in the vb which deletes .exe files from the Windows Task Manager?

Thanks,
Vikas

[vikasbhandari2]

Hello rob/static...

just want to say thanks to you, and guess what, my problem is all set now..i just have to terminate the ograph application...and for that I need to put the following line after updating the graph:

oGraph.Application.Quit

And now, I am on the Seventh Sky ...isn't it great!!!!!!

Thanks for all your support!!!!!!

Regards,
Vikas Bhandari