?
Solved

What is up with the performace??

Posted on 2005-03-16
20
Medium Priority
?
325 Views
Last Modified: 2010-05-02
I have a VB6-application that is displaying some salesstatistics from a SQL-database. The machine it is running at is not particulary slow, but something in my application must take up a lot of performace because the CPU usage peaks at almost 100 % and every now and then the application crashes. If anyone could help me with this problem I would be forever grateful! Here is the code for the main form:

Option Explicit
Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

Private Const STILE = (-20)
Private Const TRANSP = &H20&
Private tot As Integer
Private bolFore As Boolean
Private bolWeek As Boolean
Private numGif As Integer

Private Sub Form_Load()
    load_list
End Sub

'# Loads all the textboxes that dipslays the values
Public Sub load_list()
'On Error GoTo errorhandlerA
On Error Resume Next
    Timer1.Enabled = True
    Me.WindowState = vbMaximized 'Fullscreen
    Dim oConn, Cn, rsName, rs, RsFore, rsForeTot As Object
    Dim SQL, SQL2, strYear, fontColor As String
    Dim dt As Date
    Dim i, fsize, forecast As Integer
    Dim j As Long
    Dim Points, leftToFore, pointsCom, lead, tot_points, tot_orders, second As Double
    Dim bolFont As Boolean
    dt = Date
    'dt = "2005-02-07"
    strYear = Year(dt)
    bolFore = False
    tot = 0
    numGif = 0
    bolWeek = False
   
    Set oConn = CreateObject("ADODB.Connection")
    oConn.Open "driver={SQL Server};Server=preddb1;network=predictivesales;uid=telesales;pwd=telesales;database=TeleSales"
   
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "driver={SQL Server};Server=preddb1;network=predictivesales;uid=predictivesales;pwd=predictivesales;database=predictivesales"

    SQL = "SELECT DISTINCT agentid,(SELECT SUM(points) FROM PS_Billing_" & strYear & " a WHERE a.agentid = b.agentid AND a.order_date = '" & dt & "' AND a.points > 0 AND a.points IS NOT NULL) AS points, (SELECT COUNT(c.orderid) FROM PS_billing_" & strYear & " a, PS_orderinfo_" & strYear & " c WHERE a.agentid = b.agentid AND c.orderdate = '" & dt & "' AND c.orderid = a.orderid) AS orders,b.Agentid FROM tv4_dmc_" & strYear & " b WHERE b.dt = '" & dt & "' AND b.agentid <> '2608' ORDER BY b.Points DESC"
     'Debug.Print SQL
    Set rs = oConn.Execute(SQL)
   
    second = 1
    lead = 1
    i = 1

    Do While Not rs.EOF 'If no one is calling
        fontColor = vbBlack 'Default fontcolor
        fsize = 16          'Default fontsize
        bolFont = False
       
        'Get the agent name
        SQL2 = "SELECT firstname, lastname FROM users WHERE salesid =" & rs("agentid") & ""
        Set rsName = Cn.Execute(SQL2)
       
        'Get the agent forecast
        SQL2 = "SELECT forecast FROM agent_forecast_" & strYear & " WHERE agentid = " & rs("agentid") & " AND dtDate = '" & dt & "'"
        Set RsFore = Cn.Execute(SQL2)
 
        tot_orders = tot_orders + rs("orders") 'Add on the total orders
        If Not IsNull(rs("points")) Then
            Points = rs("points")
            tot_points = tot_points + Points 'Add on the total points
        Else
            Points = 0
        End If
       
        '#### LIST ORDER #####
        Load Placering(i)
        j = SetWindowLong(Placering(i).hwnd, STILE, TRANSP)
       
        'Here we decide the numbers in the list, leader is in bigger font
        If i = 1 Then 'If it is the first on the list
            lead = Points
            fsize = 18
            bolFont = True
            Placering(i).Text = i
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height
                    .Visible = True
                    .ReadGIF ("C:\Animations\1star.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf Points = pointsCom And pointsCom = lead Then 'If there is a shared lead
            fsize = 18
            bolFont = True
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height - 60
                    .Visible = True
                    .ReadGIF ("C:\Animations\1star.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf i = 2 And Points <> lead Then
            second = Points
            Placering(i).Text = i
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height - 60
                    .Visible = True
                    .ReadGIF ("C:\Animations\2star3a.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf Points = second Then
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height - 60
                    .Visible = True
                    .ReadGIF ("C:\Animations\2star3a.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf Points < pointsCom Then
            Placering(i).Text = i
        End If
       
        With Placering(i)
            .Left = Placering(0).Left
            .Top = Placering(i - 1).Top + Placering(i - 1).Height
            .Font.Size = fsize
            .Font.Bold = bolFont
            .SelStart = 0
            .SelLength = Len(Placering(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
       
        If Not RsFore.EOF Then
            bolFore = True
            forecast = RsFore("forecast")
            leftToFore = forecast - Points
            If leftToFore <= 0 Then ' If points is bigger than forecast we change fontcolor
                leftToFore = "+" & CStr(-leftToFore)
                fontColor = &H80FF&
            End If
            RsFore.Close: Set RsFore = Nothing
        End If
       
        '#### FIRST NAME #####
        Load Text1(i)
        j = SetWindowLong(Text1(i).hwnd, STILE, TRANSP)     'Makes textbox transparent
        With Text1(i)
            .Left = Text1(0).Left                           'Location from leftside of form
            .Top = Text1(i - 1).Top + Text1(i - 1).Height   'Location from top of form (same as prev + size of prev)
            .Font.Bold = bolFont
            .Font.Size = fsize                              'Font size depends on place in list
            .Text = rsName("firstname") & " " & rsName("lastname")
            .SelStart = 0                                   'Used to set font color
            .SelLength = Len(Text1(i).Text)                 'Used to set font color
            .SelColor = fontColor                           'Font color depends on if agent reached forecast
            .Visible = True                                 'Show the textbox
        End With
       
        '#### POINTS ########
        Load Text3(i)
        j = SetWindowLong(Text3(i).hwnd, STILE, TRANSP)
        With Text3(i)
            .Left = Text3(0).Left
            .Top = Text3(i - 1).Top + Text3(i - 1).Height
            .Font.Size = fsize
            .Font.Bold = bolFont
            .Text = Points
            .SelStart = 0
            .SelLength = Len(Text3(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
       
        '#### ORDERS ########
        Load Text4(i)
        j = SetWindowLong(Text4(i).hwnd, STILE, TRANSP)
        With Text4(i)
            .Left = Text4(0).Left
            .Top = Text4(i - 1).Top + Text4(i - 1).Height
            .Font.Size = fsize
            .Font.Bold = bolFont
            .Text = rs("orders")
            .SelStart = 0
            .SelLength = Len(Text4(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
                 
        If bolFore Then 'If there is a forecast in db
            '#### FORECAST ########
            Load Text5(i)
            j = SetWindowLong(Text5(i).hwnd, STILE, TRANSP)
            With Text5(i)
                .Left = Text5(0).Left
                .Top = Text5(i - 1).Top + Text5(i - 1).Height
                .BorderStyle = 0
                .Font.Size = fsize
                .Font.Bold = bolFont
                .Text = forecast
                .SelStart = 0
                .SelLength = Len(Text5(i).Text)
                .SelColor = fontColor
                .Visible = True
            End With

            '#### LEFT TO FORECAST ########
            Load Text6(i)
            j = SetWindowLong(Text6(i).hwnd, STILE, TRANSP)
            With Text6(i)
                .Left = Text6(0).Left
                .Top = Text6(i - 1).Top + Text6(i - 1).Height
                .Font.Size = fsize
                .Font.Bold = bolFont
                .Text = leftToFore
                .SelStart = 0
                .SelLength = Len(Text6(i).Text)
                .SelColor = fontColor
                .Visible = True
            End With
     
        End If
       
        pointsCom = Points
        i = i + 1
        rs.Movenext
        rsName.Close: Set rsName = Nothing
    Loop
   
    Line1.Y1 = Text4(i - 1).Top + 400
    Line1.Y2 = Text4(i - 1).Top + 400
   
    '######## TOTALS #######################################################
    fontColor = vbBlack
    fsize = 16
   
    If bolFore Then
        'Get the total forecast in db for team (subtract teamleader HÅRDKODAT!!)
        SQL = "SELECT u.team, SUM(fc.forecast) AS forecast FROM dbo.agent_Forecast_" & strYear & " fc INNER JOIN dbo.users u ON fc.agentID = u.salesid WHERE (fc.type = 'day') AND (fc.dtDate = '" & dt & "') AND (u.team = 2) AND (u.salesid <> '2634') GROUP BY u.team"
        Set rsForeTot = Cn.Execute(SQL)
       
        Dim tot_forecast, tot_left As Double
        tot_forecast = rsForeTot("forecast")
        tot_left = tot_forecast - tot_points

        'We change color if points is bigger than forecast
        If tot_left <= 0 Then
            fontColor = &H80FF&
        End If
          rsForeTot.Close: Set rsForeTot = Nothing
    End If

    '######## TOT POINTS ###########
    Load Text3(i)
    j = SetWindowLong(Text3(i).hwnd, STILE, TRANSP)
    With Text3(i)
        .Left = Text3(0).Left
        .Top = Text3(i - 1).Top + (Text3(i - 1).Height + 100)
        .Font.Size = fsize
        .Text = tot_points
        .SelStart = 0
        .SelLength = Len(Text3(i).Text)
        .SelColor = fontColor
        .Visible = True
    End With
   
    '######## TOT ORDERS ###########
    Load Text4(i)
    j = SetWindowLong(Text4(i).hwnd, STILE, TRANSP)
    With Text4(i)
        .Left = Text4(0).Left
        .Top = Text4(i - 1).Top + (Text4(i - 1).Height + 100)
        .Font.Size = fsize
        .Text = tot_orders
        .SelStart = 0
        .SelLength = Len(Text4(i).Text)
        .SelColor = fontColor
        .Visible = True
    End With
   
    If Not IsNull(forecast) And forecast <> 0 Then
       
        '######## TOT FORECAST ###########
        Load Text5(i)
        j = SetWindowLong(Text5(i).hwnd, STILE, TRANSP)
        With Text5(i)
            .Left = Text5(0).Left
            .Top = Text5(i - 1).Top + Text5(i - 1).Height + 100
            .Font.Size = fsize
            .Text = tot_forecast
            .SelStart = 0
            .SelLength = Len(Text5(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
   
        '######## TOT LEFT TO FORECAST #####
        Load Text6(i)
        j = SetWindowLong(Text6(i).hwnd, STILE, TRANSP)
        If tot_left <= 0 Then
            Text6(i).Text = "+" & CStr(-tot_left)
        Else
            Text6(i).Text = tot_left
        End If
        With Text6(i)
            .Left = Text6(0).Left
            .Top = Text6(i - 1).Top + Text6(i - 1).Height + 100
            .Font.Size = fsize
            .SelStart = 0
            .SelLength = Len(Text6(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
       
    End If

    tot = i 'To remember i for the unload_list
   
    'Clean up!
    rs.Close: Set rs = Nothing
    oConn.Close: Set oConn = Nothing
    Cn.Close: Set Cn = Nothing

Exit Sub
errorhandlerA:
    Timer1.Enabled = False
    default.Timer1.Enabled = True
    Me.Hide
    default.Show
End Sub



'#Closes the application (Picture hiding below to PredictiveTV-logo)
Private Sub Picture1_Click()
    End
End Sub

'# Timer to unload the list and then call Team list
Private Sub Timer1_Timer()
    unload_list             'Unload the list
    Timer1.Enabled = False  'Turn off timer
    If Time() > "09.00" And Time() < "22.00" Then
        TV4Team.load_teams       'Load list in other frame
        TV4Team.Show             'Show other frame
        Me.Hide                 'Hide this frame
    Else
        Night.load_me
        Night.Show              'Show other frame
        Me.Hide                 'Hide this frame
    End If
End Sub

'# Unloads all the textboxes that dipslays the values
Private Sub unload_list()
On Error GoTo errorhandlerB
    Dim i, j As Integer
    'Unload all the agents (number, firstname, lastname, points, orders)
If tot > 0 Then
    For i = 1 To (tot - 1)
        Unload TV4.Placering(i)
        Unload TV4.Text1(i)
        Unload TV4.Text3(i)
        Unload TV4.Text4(i)
        If bolFore Then
            'Unload all the agents (forecast, left to forecast)
            Unload TV4.Text5(i)
            Unload TV4.Text6(i)
        End If
    Next
   
    'And the totals (TOTAL, points, orders)

    Unload TV4.Text3(tot)
    Unload TV4.Text4(tot)
    If bolFore Then
        'And the totals (forecast, left to forecast)
        Unload TV4.Text5(tot)
        Unload TV4.Text6(tot)
    End If
   
    For j = 1 To numGif
        Unload TV4.AniGIF1(j)
    Next
End If
Exit Sub

errorhandlerB:
    Timer1.Enabled = False
    default.Timer1.Enabled = True
    Me.Hide
    default.Show
End Sub




0
Comment
Question by:prederso
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 8
  • 2
20 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 13556711
It might help to create a log, recording the time, code position and any relevant data. The log points could be placed at strategic points in the code.
You should then be able to work out which section of the code is consuming the time. The points may have to be refined in the light of results obtained.
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13556945
try adding DoEvents to all of your timers...timers are best to keep your CPU very low however if you are using a Loop use DoEvents inside your Loop
0
 

Author Comment

by:prederso
ID: 13563061
GrahamSkan, I dont really understand what and how you mean with the create a log...

egl1044, could you please give me axamples in my pice of code where you would put a DoEvents...

Im a little lost...
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:prederso
ID: 13563284
Could it be my animated gifs that is slowing the application??
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13563696
Hello prederso, usually when a systems CPU reaches 100% there is a couple of things to look for, check to make sure your loop does not go on forever, add doevents to your code, a file or program keeps opening but never closes, your program uses a file and the associated program does not end. Since you pointed out animated gif's this does have to do with files so this is were to look for the problem. I am not certain if you posted the code for the animated gif's but please post the code. So we all can take a look at it.

For example: The one time I wrote a script, I never added Wscript.Quit to the end(I forgot to add it), My CPU was at 100% I couldn't figure out why so I had to go back and look at all my code, Then I found that I forgot to add the line Wscript.Quit, After I added it my CPU was at 5% all the time.  This happended because the script was running non stop and never ended.
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13563721
Could you point out when it freezes? When does your CPU go up to 100%? as soon as you run the program or after a certain action? You could try to just disable all your timers intervals just to check if the CPU is reaching 100% if it doesn't reach 100% then we can narrow it down to the code inside the timer, however if it still reaches 100% then we have to look elsewere.
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13563764
Please remove On Error Resume Next from your code Sub_loadlist, In the hopes that vb will highlight what is wrong and allow you to debug it.  
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13563826
An alternate way to display an animated GIF is to simply add a webbrowser control to your project that points to the .GIF file on a website. Try all that I have mentioned and let us know the results.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 13563868
I meant that you could have a routine to write to a text file at different points in the program, with calls like this:

Private Sub Timer1_Timer()
    WriteLog "Timer1_Timer Event"
 ...


and perhaps:
       ...
       '#### LIST ORDER #####
       WriteLog "LIST ORDER, i = " & i
        Load Placering(i)
       ...
     
This routine would append to the log file. It creates a different file each day. There is a logging method (App.Logevent) in VB,
but it doesn't work in design mode.

Sub WriteLog(Text As String)
    Dim f As Integer
    Dim strFileName As String
    strFileName = "Par" & Format$(Now, "MMy") & ".log"
    Text = Format$(Now, "HH:nn:ss") & " " & Text
    Debug.Print Text
    f = FreeFile
    Open App.Path & "\" & strFileName For Append As #f
        Print #f, Text
    Close #f
End Sub

0
 

Author Comment

by:prederso
ID: 13590050
Wow lots of answers :) Thanks!

The animated gif-code is included (at the top below 1#### List order ####).
I tried to add DoEvents to my code and that made it much better, but I still have problems. Most every morning I have to restart the application because it freezes, but then it can run fine all day...
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13590268
prederso, have you tried disabling the timers and checking if the CPU goes to 100%, have you tried using the webbrowser control for animated .GIF's instead? Let us know so we can narrow it done
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13590341
Hello,
'Where this code is you could try the following below:

Private Sub Form_Load()

DoEvents
    load_list

End Sub

'May I ask why you want to load everyting on Form_Load?
'This might be why its freezing your application.
'If you can either add the code above to a command button and load the contents manually
'Or you can add a timer control
'Put above code into a timer control with an interval of 3000

Private Sub Timer1_Timer()

DoEvents 'let system catch up.
Text1.Text = Rnd(Int(50 * 1))

Call load_list 'code from Form_Load call sub

DoEvents
Timer1.Enabled = False 'change to your timer(disable timer)
Timer1.Interval = 0 'change to your timer(set interval at zero)

End Sub
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13590346
'I was testing this as you can see so remove the Text1.text=Rnd(Int(50 * 1)) from the Timer_ code
0
 

Author Comment

by:prederso
ID: 13590444
I have not tried to disable my timers because, but I am quite sure that would make CPU not hit 100% because if I motitor the CPU activity it peaks with the same intervals as the timers. But I still dont know if ti is the loading or unloading of my salestat, the GIFS or maybe just the database search that takes so much performance.

I tried early in my development to use a webbrowser for the gifs but there where some complications. The gif needs to be on a transparent background and there cant be any frames or anything.

I will defently try your code example egl1044. But it may take some time (a day or so) before I can say how it goes because the application is running live rigth now and when the sales force is selling I dont want to be testing to much...
0
 

Author Comment

by:prederso
ID: 13590870
I tried taking away the animated GIFs and using egl1044s code suggestions but same high CPU...
0
 

Author Comment

by:prederso
ID: 13590945
Hmmm... The sales statistic are loaded as an array of rich text boxes and when I tried with taking away a few of these the performace seemed to go down for every textbox I took away in the load_list.

Are rich text boxes particularly performance consuming or might it be the fact that I have an array of them?
0
 
LVL 29

Accepted Solution

by:
nffvrxqgrcfqvvc earned 1000 total points
ID: 13591065
'You can try this see if it works...
'Make SUB Private and not Public add sleep and DoEvents
''''''''''''''''''''''''''''''''''

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub load_list()
'On Error GoTo errorhandlerA
'On Error Resume Next
    Timer1.Enabled = True
    Me.WindowState = vbMaximized 'Fullscreen
    Dim oConn, Cn, rsName, rs, RsFore, rsForeTot As Object
    Dim SQL, SQL2, strYear, fontColor As String
    Dim dt As Date
    Dim i, fsize, forecast As Integer
    Dim j As Long
    Dim Points, leftToFore, pointsCom, lead, tot_points, tot_orders, second As Double
    Dim bolFont As Boolean
    dt = Date
    'dt = "2005-02-07"
    strYear = Year(dt)
    bolFore = False
    tot = 0
    numGif = 0
    bolWeek = False
   
    Set oConn = CreateObject("ADODB.Connection")
    oConn.Open "driver={SQL Server};Server=preddb1;network=predictivesales;uid=telesales;pwd=telesales;database=TeleSales"
            Sleep 500
            DoEvents
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "driver={SQL Server};Server=preddb1;network=predictivesales;uid=predictivesales;pwd=predictivesales;database=predictivesales"
            Sleep 500
            DoEvents

    SQL = "SELECT DISTINCT agentid,(SELECT SUM(points) FROM PS_Billing_" & strYear & " a WHERE a.agentid = b.agentid AND a.order_date = '" & dt & "' AND a.points > 0 AND a.points IS NOT NULL) AS points, (SELECT COUNT(c.orderid) FROM PS_billing_" & strYear & " a, PS_orderinfo_" & strYear & " c WHERE a.agentid = b.agentid AND c.orderdate = '" & dt & "' AND c.orderid = a.orderid) AS orders,b.Agentid FROM tv4_dmc_" & strYear & " b WHERE b.dt = '" & dt & "' AND b.agentid <> '2608' ORDER BY b.Points DESC"
     'Debug.Print SQL
            Sleep 1000
            DoEvents
    Set rs = oConn.Execute(SQL)
   
    second = 1
    lead = 1
    i = 1

    Do While Not rs.EOF 'If no one is calling
        fontColor = vbBlack 'Default fontcolor
        fsize = 16          'Default fontsize
        bolFont = False
       
        'Get the agent name
        SQL2 = "SELECT firstname, lastname FROM users WHERE salesid =" & rs("agentid") & ""
        Set rsName = Cn.Execute(SQL2)
            Sleep 1000
            DoEvents
       
        'Get the agent forecast
        SQL2 = "SELECT forecast FROM agent_forecast_" & strYear & " WHERE agentid = " & rs("agentid") & " AND dtDate = '" & dt & "'"
        Set RsFore = Cn.Execute(SQL2)
            Sleep 1000
            DoEvents
       
        tot_orders = tot_orders + rs("orders") 'Add on the total orders
        If Not IsNull(rs("points")) Then
            Points = rs("points")
            tot_points = tot_points + Points 'Add on the total points
        Else
        DoEvents
       
            Points = 0
        End If
       
        '#### LIST ORDER #####
        Load Placering(i)
        j = SetWindowLong(Placering(i).hWnd, STILE, TRANSP)
       
        'Here we decide the numbers in the list, leader is in bigger font
        If i = 1 Then 'If it is the first on the list
            lead = Points
            fsize = 18
            bolFont = True
            Placering(i).Text = i
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height
                    .Visible = True
                    Sleep 200
                    .ReadGIF ("C:\Animations\1star.gif")
                    DoEvents
                   
                End With
                numGif = numGif + 1
               
               
            End If
        ElseIf Points = pointsCom And pointsCom = lead Then 'If there is a shared lead
            fsize = 18
            bolFont = True
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height - 60
                    .Visible = True
                    .ReadGIF ("C:\Animations\1star.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf i = 2 And Points <> lead Then
            second = Points
            Placering(i).Text = i
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height - 60
                    .Visible = True
                    .ReadGIF ("C:\Animations\2star3a.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf Points = second Then
            If Points > 0 Then
                Load AniGIF1(i)
                With AniGIF1(i)
                    .Left = AniGIF1(0).Left
                    .Top = AniGIF1(i - 1).Top + AniGIF1(i - 1).Height - 60
                    .Visible = True
                    .ReadGIF ("C:\Animations\2star3a.gif")
                End With
                numGif = numGif + 1
            End If
        ElseIf Points < pointsCom Then
            Placering(i).Text = i
        End If
       
        With Placering(i)
            .Left = Placering(0).Left
            .Top = Placering(i - 1).Top + Placering(i - 1).Height
            .Font.Size = fsize
            .Font.Bold = bolFont
            .SelStart = 0
            .SelLength = Len(Placering(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
       
        If Not RsFore.EOF Then
            bolFore = True
            forecast = RsFore("forecast")
            leftToFore = forecast - Points
            If leftToFore <= 0 Then ' If points is bigger than forecast we change fontcolor
                leftToFore = "+" & CStr(-leftToFore)
                fontColor = &H80FF&
            End If
            RsFore.Close: Set RsFore = Nothing
        End If
       
        '#### FIRST NAME #####
        Load Text1(i)
        DoEvents
        j = SetWindowLong(Text1(i).hWnd, STILE, TRANSP)     'Makes textbox transparent
        With Text1(i)
       
            .Left = Text1(0).Left                           'Location from leftside of form
            .Top = Text1(i - 1).Top + Text1(i - 1).Height   'Location from top of form (same as prev + size of prev)
            .Font.Bold = bolFont
            .Font.Size = fsize                              'Font size depends on place in list
            .Text = rsName("firstname") & " " & rsName("lastname")
            .SelStart = 0                                   'Used to set font color
            .SelLength = Len(Text1(i).Text)                 'Used to set font color
            .SelColor = fontColor                           'Font color depends on if agent reached forecast
            .Visible = True                                 'Show the textbox
        End With
       
        '#### POINTS ########
        Load Text3(i)
        DoEvents
        j = SetWindowLong(Text3(i).hWnd, STILE, TRANSP)
        With Text3(i)
            .Left = Text3(0).Left
            .Top = Text3(i - 1).Top + Text3(i - 1).Height
            .Font.Size = fsize
            .Font.Bold = bolFont
            .Text = Points
            .SelStart = 0
            .SelLength = Len(Text3(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
       
        '#### ORDERS ########
        Load Text4(i)
        DoEvents
       
        j = SetWindowLong(Text4(i).hWnd, STILE, TRANSP)
        With Text4(i)
            .Left = Text4(0).Left
            .Top = Text4(i - 1).Top + Text4(i - 1).Height
            .Font.Size = fsize
            .Font.Bold = bolFont
            .Text = rs("orders")
            .SelStart = 0
            .SelLength = Len(Text4(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
                 
        If bolFore Then 'If there is a forecast in db
            '#### FORECAST ########
            Load Text5(i)
            DoEvents
            j = SetWindowLong(Text5(i).hWnd, STILE, TRANSP)
            With Text5(i)
                .Left = Text5(0).Left
                .Top = Text5(i - 1).Top + Text5(i - 1).Height
                .BorderStyle = 0
                .Font.Size = fsize
                .Font.Bold = bolFont
                .Text = forecast
                .SelStart = 0
                .SelLength = Len(Text5(i).Text)
                .SelColor = fontColor
                .Visible = True
            End With

            '#### LEFT TO FORECAST ########
            Load Text6(i)
            DoEvents
            j = SetWindowLong(Text6(i).hWnd, STILE, TRANSP)
            With Text6(i)
                .Left = Text6(0).Left
                .Top = Text6(i - 1).Top + Text6(i - 1).Height
                .Font.Size = fsize
                .Font.Bold = bolFont
                .Text = leftToFore
                .SelStart = 0
                .SelLength = Len(Text6(i).Text)
                .SelColor = fontColor
                .Visible = True
            End With
     
        End If
       
        pointsCom = Points
        i = i + 1
        rs.Movenext
        rsName.Close: Set rsName = Nothing
    Loop
   
    Line1.Y1 = Text4(i - 1).Top + 400
    Line1.Y2 = Text4(i - 1).Top + 400
   
    '######## TOTALS #######################################################
    fontColor = vbBlack
    fsize = 16
   
    If bolFore Then
        'Get the total forecast in db for team (subtract teamleader HÅRDKODAT!!)
        SQL = "SELECT u.team, SUM(fc.forecast) AS forecast FROM dbo.agent_Forecast_" & strYear & " fc INNER JOIN dbo.users u ON fc.agentID = u.salesid WHERE (fc.type = 'day') AND (fc.dtDate = '" & dt & "') AND (u.team = 2) AND (u.salesid <> '2634') GROUP BY u.team"
        Set rsForeTot = Cn.Execute(SQL)
        Sleep 1000
        DoEvents
       
        Dim tot_forecast, tot_left As Double
        tot_forecast = rsForeTot("forecast")
        tot_left = tot_forecast - tot_points

        'We change color if points is bigger than forecast
        If tot_left <= 0 Then
            fontColor = &H80FF&
        End If
          rsForeTot.Close: Set rsForeTot = Nothing
    End If

    '######## TOT POINTS ###########
    Load Text3(i)
    DoEvents
   
    j = SetWindowLong(Text3(i).hWnd, STILE, TRANSP)
    With Text3(i)
        .Left = Text3(0).Left
        .Top = Text3(i - 1).Top + (Text3(i - 1).Height + 100)
        .Font.Size = fsize
        .Text = tot_points
        .SelStart = 0
        .SelLength = Len(Text3(i).Text)
        .SelColor = fontColor
        .Visible = True
    End With
   
    '######## TOT ORDERS ###########
    Load Text4(i)
    DoEvents
   
    j = SetWindowLong(Text4(i).hWnd, STILE, TRANSP)
    With Text4(i)
        .Left = Text4(0).Left
        .Top = Text4(i - 1).Top + (Text4(i - 1).Height + 100)
        .Font.Size = fsize
        .Text = tot_orders
        .SelStart = 0
        .SelLength = Len(Text4(i).Text)
        .SelColor = fontColor
        .Visible = True
    End With
   
    If Not IsNull(forecast) And forecast <> 0 Then
       
        '######## TOT FORECAST ###########
        Load Text5(i)
        DoEvents
       
        j = SetWindowLong(Text5(i).hWnd, STILE, TRANSP)
        With Text5(i)
            .Left = Text5(0).Left
            .Top = Text5(i - 1).Top + Text5(i - 1).Height + 100
            .Font.Size = fsize
            .Text = tot_forecast
            .SelStart = 0
            .SelLength = Len(Text5(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
   
        '######## TOT LEFT TO FORECAST #####
        Load Text6(i)
        DoEvents
       
        j = SetWindowLong(Text6(i).hWnd, STILE, TRANSP)
        If tot_left <= 0 Then
            Text6(i).Text = "+" & CStr(-tot_left)
        Else
            Text6(i).Text = tot_left
        End If
        With Text6(i)
            .Left = Text6(0).Left
            .Top = Text6(i - 1).Top + Text6(i - 1).Height + 100
            .Font.Size = fsize
            .SelStart = 0
            .SelLength = Len(Text6(i).Text)
            .SelColor = fontColor
            .Visible = True
        End With
        DoEvents
    End If

    tot = i 'To remember i for the unload_list
   
    'Clean up!
    rs.Close: Set rs = Nothing
    oConn.Close: Set oConn = Nothing
    Cn.Close: Set Cn = Nothing
DoEvents
Exit Sub
errorhandlerA:
    Timer1.Enabled = False
    Default.Timer1.Enabled = True
    Me.Hide
    Default.Show
End Sub

0
 

Author Comment

by:prederso
ID: 13591499
That suggestion seems to be working great!! When I test it on my machinge the CPU went down  and peaks instead at under 20%. I assume it will work in the live enviroment as well, so lots of thanks to you egl1044!

If you have time... could you please explain exactly what the sleep and DoEvents are doing to help me?  (I hate not to understnad my own code:)
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13592496
Well since that is a very long SUB making it a private sub rather than a public sub uses less resources in itself because it doesnt stay in memory.

Adding sleep lets the call initiate then calling DoEvents allows the system to catch up for the next call.
0
 

Author Comment

by:prederso
ID: 13598827
Thanks!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question