none
VBA Excel process Slow RRS feed

 > 

  • Question

  • Question
    Sign in to vote
    0
    Sign in to vote
    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

  • Question
    Sign in to vote
    0
    Sign in to vote

    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
    |
  • Question
    Sign in to vote
    0
    Sign in to vote

    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
    |