help speeding up code

I'm having a tough time speeding up some code.  My task is to find the top 50 customers (within some defined time parameters) out of about 3500 customers in the customer table.  The order date and customer number are stored in a header file (currently 50,000 records and growing) and the sales detail is stored in a detail file (311,000 records).  The tables are not designed or populated by me; I'm just trying to get the information out.

i use an array to accumulate the information, then store that in a table by customer so that it can be recalled on next startup

The array consists of elements 1 (current year), 2 (last year), 3 (last ytd), 4 thru 15 (Jan - Dec this year)

"Top 50" is based on current year sales

This is written in VB6 against a SQL Server database

This code takes 14 minutes to run, which seems like too much -- is there another method of attack that would reduce the processing time?

Private Sub cmdRefresh_Click()
    Dim rs1 As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
    Dim rs3 As ADODB.Recordset
    Const strFr10 As String = "##,###,##0"
    Const strfr9 As String = "#,###,##0"
    Dim lngJan1TY As Long
    Dim lngJan1LY As Long
    Dim lngDec31TY As Long
    Dim lngDec31LY As Long
    Dim lngTDLY As Long
    Dim dblAmt As Double
    Dim alngFileAmt(1 To 15) As Long
    Dim i As Integer
    Dim strSql As String
   
    Debug.Print "start " & CStr(Now)
   
    Me.MousePointer = vbHourglass
    cmdRefresh.Enabled = False
    flx1.Visible = False
    flx1.Enabled = False
    flx1.Rows = 1
   
    Call getConn   'my connection string is         "Provider=SQLOLEDB.1;" & _
                                                                    "Persist Security Info=False;" & _
                                                                    "User ID=" & strUserId & ";" & _
                                                                    "Password=" & strPW & ";" & _
                                                                    "Initial Catalog=" & strCatalog & ";" & _
                                                                    "Data Source=" & strDataSource

   
    'update parameters
    g_cnnActive.Execute "UPDATE top50sls_fli SET lr_date = " & _
        Format(Date, "YYYYMMDD") & ", lr_yr = '" & lstYr.List(lstYr.ListIndex) & "'"
    txtInfo(0).Text = Format(Date, "MM/DD/YYYY")
    txtInfo(1).Text = lstYr.List(lstYr.ListIndex)
   
    Set rs1 = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    Set rs3 = New ADODB.Recordset
   
    Set rs1.ActiveConnection = g_cnnActive
    Set rs2.ActiveConnection = g_cnnActive
    Set rs3.ActiveConnection = g_cnnActive
   
    If gbolSuppRefresh = False Then
        'get dates
        lngJan1TY = lstYr.List(lstYr.ListIndex) + "0101" 'January 1 of the "current" year
        lngJan1LY = CStr(CLng(lstYr.List(lstYr.ListIndex) - 1)) + "0101" 'January 1 of the "previous" year
        lngDec31TY = lstYr.List(lstYr.ListIndex) + "1231" 'December 31 of the "current" year
        lngDec31LY = CStr(CLng(lstYr.List(lstYr.ListIndex) - 1)) + "1231" 'December 31 of the previous" year
        lngTDLY = CStr(Year(Date) - 1) + CStr(Month(Date)) + CStr(Day(Date))
        'clear file
        g_cnnActive.Execute "TRUNCATE TABLE top50act_fli"
       
        'get new information into the file
       
        rs1.Open "SELECT customer FROM customer_table ORDER BY customer"
       
        Do While Not rs1.EOF
            stb1.Panels(1).Text = " " & Right(rs1.Fields("customer"), 5) & "  "
            'clear array
            Erase alngFileAmt
           
            rs2.Open "SELECT type,orig_type,order_num,order_dt FROM hdrhstTable WHERE order_dt " & _
                "BETWEEN " & lngJan1LY & " And " & lngDec31TY & " And customer = '" & _
                rs1.Fields("customer").Value & "'"
           
            Do While Not rs2.EOF
                dblAmt = 0
                If rs2.Fields("orig_type").Value = "C" Then
                    rs3.Open "SELECT SUM(ship_qty * price) [Amt] FROM dethstTable WHERE " & _
                        "type = '" & rs2.Fields("type").Value & "' And order_num = '" & _
                        rs2.Fields("order_num").Value & "'"
                   
                    If Not IsNull(rs3.Fields("Amt").Value) Then
                        dblAmt = rs3.Fields("Amt").Value
                    End If
                   
                    rs3.Close
                Else
                    rs3.Open "SELECT SUM(order_qty * price) [Amt] FROM dethstTable WHERE " & _
                        "type = '" & rs2.Fields("type").Value & "' And order_num = '" & _
                        rs2.Fields("order_num").Value & "'"
                   
                    If Not IsNull(rs3.Fields("Amt").Value) Then
                        dblAmt = rs3.Fields("Amt").Value
                    End If
                   
                    rs3.Close
                End If
               
                If rs2.Fields("order_dt").Value >= lngJan1TY And _
                            rs2.Fields("order_dt").Value <= lngDec31TY Then
                    alngFileAmt(1) = alngFileAmt(1) + dblAmt
                   
                    'now get the monthly amount in there
                    alngFileAmt(CInt(Mid(rs2.Fields("order_dt").Value, 5, 2)) + 3) = _
                        alngFileAmt(CInt(Mid(rs2.Fields("order_dt").Value, 5, 2)) + 3) + dblAmt
                End If
               
                If rs2.Fields("order_dt").Value >= lngJan1LY And _
                            rs2.Fields("order_dt").Value <= lngDec31LY Then
                    alngFileAmt(2) = alngFileAmt(2) + dblAmt
                End If
               
                If rs2.Fields("order_dt").Value >= lngJan1LY And _
                            rs2.Fields("order_dt").Value <= lngTDLY Then
                    alngFileAmt(3) = alngFileAmt(3) + dblAmt
                End If

                rs2.MoveNext
            Loop
           
            rs2.Close
           
            'file the information about this customer
            '   (if there are any sales this year)
            If alngFileAmt(1) > 0 Then
                strSql = "INSERT INTO top50act_fli (customer,tot_cy,tot_ly,tot_ly_ytd," & _
                    "jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dem) VALUES ('" & _
                    Right(rs1.Fields("customer").Value, 5) & "'"
               
                For i = 1 To 15
                    strSql = strSql & "," & alngFileAmt(i)
                Next 'i
               
                strSql = strSql & ")"
                g_cnnActive.Execute strSql
            End If
            DoEvents
           
            rs1.MoveNext
        Loop
        rs1.Close
    End If
   
    'put information into the grid
    rs1.Open "SELECT customer,tot_cy,tot_ly,tot_ly_ytd,jan,feb,mar,apr,may,jun,jul,aug," & _
        "sep,oct,nov,dem FROM top50act_fli ORDER BY tot_cy DESC"
       
    Do While Not rs1.EOF
        With flx1
            .Rows = .Rows + 1
            .Row = .Rows - 1
            .Col = 0
            .Text = rs1.Fields("customer").Value
            .Col = 1
            .Text = padLeft(Format(rs1.Fields("tot_cy").Value, strFr10), 10)
            .Col = 2
            .Text = padLeft(Format(rs1.Fields("tot_ly").Value, strFr10), 10)
            .Col = 3
            .Text = padLeft(Format(rs1.Fields("tot_ly_ytd").Value, strFr10), 10)
            .Col = 4
            .Text = padLeft(Format(rs1.Fields("jan").Value, strfr9), 9)
            .Col = 5
            .Text = padLeft(Format(rs1.Fields("feb").Value, strfr9), 9)
            .Col = 6
            .Text = padLeft(Format(rs1.Fields("mar").Value, strfr9), 9)
            .Col = 7
            .Text = padLeft(Format(rs1.Fields("apr").Value, strfr9), 9)
            .Col = 8
            .Text = padLeft(Format(rs1.Fields("may").Value, strfr9), 9)
            .Col = 9
            .Text = padLeft(Format(rs1.Fields("jun").Value, strfr9), 9)
            .Col = 10
            .Text = padLeft(Format(rs1.Fields("jul").Value, strfr9), 9)
            .Col = 11
            .Text = padLeft(Format(rs1.Fields("aug").Value, strfr9), 9)
            .Col = 12
            .Text = padLeft(Format(rs1.Fields("sep").Value, strfr9), 9)
            .Col = 13
            .Text = padLeft(Format(rs1.Fields("oct").Value, strfr9), 9)
            .Col = 14
            .Text = padLeft(Format(rs1.Fields("nov").Value, strfr9), 9)
            .Col = 15
            .Text = padLeft(Format(rs1.Fields("dem").Value, strfr9), 9)
        End With
       
        If flx1.Rows = 51 Then
            Exit Do
        End If
       
        rs1.MoveNext
    Loop
   
    rs1.Close
   
    Set rs1.ActiveConnection = Nothing
    Set rs2.ActiveConnection = Nothing
    Set rs3.ActiveConnection = Nothing
   
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set rs3 = Nothing
   
    Call closeConn
   
    flx1.Enabled = True
    flx1.Visible = True
    cmdRefresh.Enabled = True
    stb1.Panels(1).Text = ""
    Me.MousePointer = vbDefault
   
    Debug.Print "end " & CStr(Now)
End Sub