none
VBA Excel process Slow RRS feed

  • Question

  • HI, i written VBA macro program in excel application and connect to MS SQL database to collect data. But during process time it will hang and not response. kindly advise.. thank you. 
    Friday, August 24, 2012 6:49 AM

All replies

  • Hi Caulson,

    Would you mind posting some of the code here. There are many ways to connect to a database and collect data. Your code will help us determine how you are actually implementing the process. This will allow us to make better suggestions.

    Thanks,

    Mike


    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Friday, August 24, 2012 1:59 PM
  • HI, as below is my VBA code

    Private Sub CommandButton1_Click()
     Call delaylot
    End Sub
    
    Sub delaylot()
        Dim strSQL, strSQL1 As String
        Dim qRS As New Recordset
        Dim cn As ADODB.Connection
        Dim R, I As Integer
        Dim HoldTime1 As Date
        Dim strLOTID As String
    
    Worksheets("delay lot").Range("A7:M65534").ClearContents
        Set cn = New ADODB.Connection
    
    
        cn.Open cnProvider
    
        
    
     
        
        strSQL = "select * ,(SELECT MAX(MODIFY_DATE) from SIM_WIP_LOTTRACKING where SIM_WIP_LOTTRACKING.LOT_ID=SIM_WIP_LOTINFO.LOT_ID) as modify "
        strSQL = strSQL + ",(Select DESC_ENGLISH FROM SIM_PRP_STEP WHERE SIM_PRP_STEP.ISSUE_STATUS='Active' AND SIM_PRP_STEP.STEP_ID=SIM_WIP_LOTINFO.STEP_ID) as StepName"
        strSQL = strSQL + " From SIM_WIP_LOTINFO "
        strSQL = strSQL + " where LOT_STATUS IN ('HOLD','RUN','RHOLD','WAIT') "
        strSQL = strSQL + " order by modify "
    '
    
    
    
        qRS.Open strSQL, cn
        
        
       R = 7
        Do
        If qRS.EOF = False Then
           Worksheets("delay lot").Cells(R, 1) = qRS.Fields("Lot_ID")
           Worksheets("delay lot").Cells(R, 2) = qRS.Fields("LOT_STATUS")
           Worksheets("delay lot").Cells(R, 3) = qRS.Fields("STEP_ID")
        '    Worksheets("delay lot").Cells(R, 4) = qRS.Fields("StepName")
        '   Worksheets("delay lot").Cells(R, 5) = qRS.Fields("PRODUCT_ID")
        '   Worksheets("delay lot").Cells(R, 6) = qRS.Fields("PLAN_ID")
           Worksheets("delay lot").Cells(R, 4) = qRS.Fields("LOT_TYPE")
           Worksheets("delay lot").Cells(R, 5) = qRS.Fields("QTY")
           HoldTime1 = Left(qRS.Fields("modify"), 4) & "/" & Mid(qRS.Fields("modify"), 5, 2) & "/" & Mid(qRS.Fields("modify"), 7, 2) & " " & Mid(qRS.Fields("modify"), 10, 2) & ":" & Mid(qRS.Fields("modify"), 12, 2) & ":" & Mid(qRS.Fields("modify"), 14, 2)
            Worksheets("delay lot").Cells(R, 6) = HoldTime1
            Worksheets("delay lot").Cells(R, 7) = "=(NOW()-f" & R & ")*24"
             Worksheets("delay lot").Cells(R, 8) = qRS.Fields("EQP_ID")
           Worksheets("delay lot").Cells(R, 9) = qRS.Fields("WO_ID")
        
    
          
           Worksheets("delay lot").Cells(R, 10) = Worksheets("delay lot").Cells(R, 3) & Worksheets("delay lot").Cells(R, 2)
           Worksheets("delay lot").Cells(R, 11) = Mid(Worksheets("delay lot").Cells(R, 9), 8, 1) & Worksheets("delay lot").Cells(R, 3) & Worksheets("delay lot").Cells(R, 2)
           'Worksheets("delay lot").Cells(R, 13)="=IF(MID(H"&R&",4,3)="NWS",IF((G"R"-2)>1,MID(H"R",4,3),""),MID(H"R",4,3))"
           
    
           
           
           
           
              qRS.MoveNext
            R = R + 1
        
        Else
          Exit Do
        End If
        Loop
        
    
    
       
        
        
        
       
        
        qRS.Close
        cn.Close
        Set qRS = Nothing
        Set cn = Nothing
         
     
        
        
    
        
      Sheets("delay lot").Select
         Range("BC14").Select
        ActiveSheet.PivotTables("˜Ð¼~·ÖÎö±í1").PivotCache.Refresh
        Range("BC34").Select
        ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
        ActiveWindow.SmallScroll Down:=39
        Range("BC69").Select
        ActiveSheet.PivotTables("PivotTable8").PivotCache.Refresh
        ActiveWindow.SmallScroll Down:=33
        Range("BC99").Select
        ActiveSheet.PivotTables("PivotTable9").PivotCache.Refresh
        ActiveWindow.SmallScroll Down:=24
        'MsgBox "Complete"
        
        
        
        
        
        
        
        
    End Sub
    
    
    
    Sub Test()
    
    x = 7
    
    
    y = 0
    z = 7
    Do Until Sheets("delay lot").Cells(z, 12) = ""
      x = 7
      y = 0
      Do Until Sheets("delay lot").Cells(x, 3) > "3500"
        If Sheets("delay lot").Cells(x, 2) = "" Then
        Exit Do
        Else
        If Sheets("delay lot").Cells(x, 11) = Sheets("delay lot").Cells(z, 12) Then
      y = y + 1
      x = x + 1
      Else
      x = x + 1
      End If
      End If
      Loop
      
     Sheets("delay lot").Cells(z, 13) = y
       z = z + 1
    Loop
        Sheets("delay lot").Cells(1, 13) = x
    
    x = Sheets("delay lot").Cells(1, 13)
    y = 0
    z = 7
    Do Until Sheets("delay lot").Cells(z, 12) = ""
      x = Sheets("delay lot").Cells(1, 13)
      y = 0
      Do Until Sheets("delay lot").Cells(x, 2) = ""
        If Sheets("delay lot").Cells(x, 11) = Sheets("delay lot").Cells(z, 12) Then
      y = y + Sheets("delay lot").Cells(x, 5)
      x = x + 1
      Else
      x = x + 1
      End If
      Loop
      
     Sheets("delay lot").Cells(z, 14) = y
       z = z + 1
    Loop
        Sheets("delay lot").Cells(1, 14) = x
        
    
    
    '   Columns("B:B").Select
    '    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
    '        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    '        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    '        :=Array(1, 1), TrailingMinusNumbers:=True
    
    
    x = 7
    y = 0
    z = 7
    Do Until Sheets("delay lot").Cells(z, 16) = ""
      x = 7
      y = 0
      Do Until Sheets("delay lot").Cells(x, 3) > "3500"
          If Sheets("delay lot").Cells(x, 3) = "" Then
        Exit Do
        Else
    
        If Sheets("delay lot").Cells(x, 3) = Sheets("delay lot").Cells(z, 16) Then
      y = y + 1
      x = x + 1
      Else
      x = x + 1
      End If
      End If
      Loop
      
     Sheets("delay lot").Cells(z, 17) = y
       z = z + 1
    Loop
        Sheets("delay lot").Cells(1, 17) = x
    
    x = Sheets("delay lot").Cells(1, 17)
    y = 0
    z = 7
    Do Until Sheets("delay lot").Cells(z, 16) = ""
      x = Sheets("delay lot").Cells(1, 17)
      y = 0
      Do Until Sheets("delay lot").Cells(x, 3) = ""
        If Sheets("delay lot").Cells(x, 3) = Sheets("Move").Cells(z, 16) Then
      y = y + Sheets("delay lot").Cells(x, 5)
      x = x + 1
      Else
      x = x + 1
      End If
      Loop
      
     Sheets("delay lot").Cells(z, 18) = y
       z = z + 1
    Loop
        Sheets("delay lot").Cells(1, 18) = x
        
    
        
    
    x = 0
    y = 7
    Do Until Sheets("delay lot").Cells(y, 13) = ""
    x = x + Sheets("delay lot").Cells(y, 13)
    y = y + 1
    Loop
    Sheets("delay lot").Cells(4, 4) = x
    
    x = 0
    y = 7
    Do Until Sheets("delay lot").Cells(y, 14) = ""
    x = x + Sheets("delay lot").Cells(y, 14)
    y = y + 1
    Loop
    Sheets("delay lot").Cells(4, 6) = x
    End Sub
    
    
    
    

    Private Sub CommandButton1_Click()
     Call GetHOLDHST
    End Sub
    
    Public Sub GetHOLDHST()
        Dim strSQL As String
        Dim qRS As New Recordset
        Dim cn As ADODB.Connection
        Dim HoldTime1, ReleaseTime1 As Date
        Dim strStartTime As String
        Dim strEndTime As String
        Dim RTime As String
        Dim FROMDAY, ENDDAY As String
        Dim R As Integer
    
    
        Set cn = New ADODB.Connection
    
        Worksheets("Hold History").Range("A3:q65534").ClearContents
        cn.Open cnProvider
    
    
    
        FROMDAY = Worksheets("Hold History").Range("c1")
        ENDDAY = Worksheets("Hold History").Range("E1")
     
    
         strStartTime = "'" & FROMDAY & " 070000000" & "'"
         strEndTime = "'" & ENDDAY + 1 & " 070000000" & "'"
        
        strSQL = "select A.*,B.CREATE_DATE,b.REASON_CODE,B.COMMENTS "
        strSQL = strSQL + ",(Select DESC_ENGLISH FROM SIM_PRP_STEP WHERE SIM_PRP_STEP.ISSUE_STATUS='Active' AND STEP_ID=A.STEP_ID) as StepName  "
        strSQL = strSQL + " from SIM_WIP_HOLDRELEASE A,SIM_WIP_LOTTXN B"
        strSQL = strSQL + " WHERE A.HOLD_DATE >=  " & strStartTime
        strSQL = strSQL + " and A.HOLD_DATE <  " & strEndTime
        strSQL = strSQL + " and A.LOT_ID=B.LOT_ID "
        strSQL = strSQL + " and A.HOLD_DATE=B.CREATE_DATE "
        strSQL = strSQL + " ORDER BY A.HOLD_DATE "
      
        
      
      
        qRS.Open strSQL, cn
        
        R = 3
        Do
        If qRS.EOF = False Then
            Worksheets("Hold History").Cells(R, 1) = qRS.Fields("Lot_ID")
            Worksheets("Hold History").Cells(R, 2) = qRS.Fields("STEP_ID")
            Worksheets("Hold History").Cells(R, 3) = qRS.Fields("stepname")
            Worksheets("Hold History").Cells(R, 4) = qRS.Fields("HOLD_TYPE")
            Worksheets("Hold History").Cells(R, 5) = qRS.Fields("HOLD_QTY")
            Worksheets("Hold History").Cells(R, 7) = Left(qRS.Fields("HOLD_DATE"), 4) & "/" & Mid(qRS.Fields("HOLD_DATE"), 5, 2) & "/" & Mid(qRS.Fields("HOLD_DATE"), 7, 2) & " " & Mid(qRS.Fields("HOLD_DATE"), 10, 2) & ":" & Mid(qRS.Fields("HOLD_DATE"), 12, 2) & ":" & Mid(qRS.Fields("HOLD_DATE"), 14, 2)
            Worksheets("Hold History").Cells(R, 8) = qRS.Fields("HOLD_USER")
            Worksheets("Hold History").Cells(R, 9) = qRS.Fields("RELEASE_DATE")
            RTime = Worksheets("Hold History").Cells(R, 9)
            If RTime = "" Then
            
              Else
               ReleaseTime1 = Left(RTime, 4) & "/" & Mid(RTime, 5, 2) & "/" & Mid(RTime, 7, 2) & " " & Mid(RTime, 10, 2) & ":" & Mid(RTime, 12, 2) & ":" & Mid(RTime, 14, 2)
                Worksheets("Hold History").Cells(R, 9) = ReleaseTime1
            
            Worksheets("Hold History").Cells(R, 10) = qRS.Fields("RELEASE_USER")
            Worksheets("Hold History").Cells(R, 11) = (Worksheets("Hold History").Cells(R, 9) - Worksheets("Hold History").Cells(R, 7)) * 24
            
            End If
            Worksheets("Hold History").Cells(R, 12) = qRS.Fields("REASON_CODE")
            Worksheets("Hold History").Cells(R, 13) = qRS.Fields("COMMENTS")
            
               qRS.MoveNext
            R = R + 1
        
        Else
          Exit Do
        End If
        Loop
        
        
        qRS.Close
        cn.Close
        Set qRS = Nothing
        Set cn = Nothing
        
            
            Set cn = New ADODB.Connection
        cn.Open cnProvider
    
        DD = 3
        
        strSQL = ""
        strSQL = strSQL + "SELECT *"
        strSQL = strSQL + " from RPT_HISTORY_LOTINFO "
        strSQL = strSQL + " where LOT_ID IN("
          Do Until Sheets("Hold History").Cells(DD, 1) = ""
             strSQL = strSQL & "'" & Sheets("Hold History").Cells(DD, 1) & "',"
             DD = DD + 1
          Loop
             strSQL = strSQL & "'_')"
     
     '   'MsgBox strSQL
        qRS.Open strSQL, cn '
    
    
          x = 3
        
        
       Do Until Sheets("Hold History").Cells(x, 1) = ""
       
        
        Do Until qRS.EOF
        
       If Sheets("Hold History").Cells(x, 1) = qRS(0) Then
    '    Sheets("PushOutput").Cells(x, 18) = qRS(1)
    '    Sheets("PushOutput").Cells(x, 19) = qRS(2)
    '    Sheets("PushOutput").Cells(x, 20) = qRS(3)
    '    Sheets("PushOutput").Cells(x, 21) = qRS(3)
    '    Sheets("PushOutput").Cells(x, 22) = qRS(4)
    '    Sheets("PushOutput").Cells(x, 23) = qRS(5)
    '    Sheets("PushOutput").Cells(x, 24) = Left(qRS(6), 4) & "/" & Mid(qRS(6), 5, 2) & "/" & Mid(qRS(6), 7, 2) & " " & Mid(qRS(6), 10, 2) & ":" & Mid(qRS(6), 12, 2) & ":" & Mid(qRS(6), 14, 2)
    '    Sheets("PushOutput").Cells(x, 25) = Left(qRS(7), 4) & "/" & Mid(qRS(7), 5, 2) & "/" & Mid(qRS(7), 7, 2) & " " & Mid(qRS(7), 10, 2) & ":" & Mid(qRS(7), 12, 2) & ":" & Mid(qRS(7), 14, 2)
    '    Sheets("PushOutput").Cells(x, 26) = Left(qRS(8), 4) & "/" & Mid(qRS(8), 5, 2) & "/" & Mid(qRS(8), 7, 2) & " " & Mid(qRS(8), 10, 2) & ":" & Mid(qRS(8), 12, 2) & ":" & Mid(qRS(8), 14, 2)
    '    Sheets("PushOutput").Cells(x, 27) = Left(qRS(10), 4) & "/" & Mid(qRS(10), 5, 2) & "/" & Mid(qRS(10), 7, 2) & " " & Mid(qRS(10), 10, 2) & ":" & Mid(qRS(10), 12, 2) & ":" & Mid(qRS(10), 14, 2)
    '    Sheets("PushOutput").Cells(x, 28) = Left(qRS(11), 4) & "/" & Mid(qRS(11), 5, 2) & "/" & Mid(qRS(11), 7, 2) & " " & Mid(qRS(11), 10, 2) & ":" & Mid(qRS(11), 12, 2) & ":" & Mid(qRS(11), 14, 2)
    '    If qRS(12) = "" Then
    '       Sheets("PushOutput").Cells(x, 29) = ""
    '    Else
    '    Sheets("PushOutput").Cells(x, 29) = Left(qRS(12), 4) & "/" & Mid(qRS(12), 5, 2) & "/" & Mid(qRS(12), 7, 2) & " " & Mid(qRS(12), 10, 2) & ":" & Mid(qRS(12), 12, 2) & ":" & Mid(qRS(12), 14, 2)
    '   End If
    '    Sheets("PushOutput").Cells(x, 30) = Left(qRS(13), 4) & "/" & Mid(qRS(13), 5, 2) & "/" & Mid(qRS(13), 7, 2) & " " & Mid(qRS(13), 10, 2) & ":" & Mid(qRS(13), 12, 2) & ":" & Mid(qRS(13), 14, 2)
    '    Sheets("PushOutput").Cells(x, 31) = qRS(14)
    '    Sheets("PushOutput").Cells(x, 32) = qRS(15)
    '    Sheets("PushOutput").Cells(x, 33) = qRS(16)
    '    Sheets("PushOutput").Cells(x, 34) = qRS(17)
    '    Sheets("PushOutput").Cells(x, 35) = qRS(18)
    '    Sheets("PushOutput").Cells(x, 36) = qRS(19)
    '    Sheets("PushOutput").Cells(x, 37) = qRS(20)
       Sheets("Hold History").Cells(x, 6) = qRS(21)
    
        
        
        
        
        'Sheets("PushOutput").Cells(x, 15) = 24 * (Now() - Sheets("PushOutput").Cells(x, 16))
        End If
                 
                 qRS.MoveNext
        
        Loop
           x = x + 1
                 qRS.MoveFirst
    
        Loop
      
        
        
        
           
     '   Selection.AutoFilter Field:=14, Criteria1:="<>FINISH", Operator:=xlAnd, _
     '       Criteria2:="<>TER"
    
    
    
            
        qRS.Close
        cn.Close
        Set qRS = Nothing
        Set cn = Nothing
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        MsgBox "Complete"
    End Sub
    

    Monday, August 27, 2012 1:25 AM