Sugestions to optimize and speed an simple vba code that is taking hours to proccess

[mfaqueiroz]

Hi, everyone!


I've two tables: dictionary and InputTable. The table dictionary have 2202 entries and the InputTable 65536.
I've a key that is formed by 3 fields of this tables, the ideia is to look on dictionary an row with the same key and then write on InputTable the description that is on dicionary.

I've write one code for this, but it is very very slow is taking almost 4 hours to finish this task. Do you have any suggestion to optimize my code?


Sub writeonInputTable()
Dim key1 as string
Dim key2 as sting
Dim description as string

Set dbs =DBEngine(0)(0)
Set dictionary= dbs.OpenRecordset("Dic",DB_OPEN_DYNASET)
Set InputTable= dbs.OpenRecordset("Input",DB_OPEN_DYNASET)


dictionary.MoveFirst
Do While not Dicionary.EOF
Key1=dictionary.Fields(1).Value & dictionary.Fields(2).Value & dictionary.Fields(3).Value
Description=dictionary.Fields(4)

InputTable.MoveFirst
Key2=InputTable.Fields(1).Value & InputTable.Fields(2).Value & InputTable.Fields(3).Value

If Key1=Key2 then
InputTable.Edit
InputTable.Fields(4)=Description
InputTable.Update


End if
InputTable.MoveNext
Loop
dictionary.MoveNext
Loop
End Sub

I really appreciate your help,
I wish everyone a happy new year!

 

[arnelgp]

DoCmd.RunSql "UPDATE [input] AS T1 INNER JOIN [dic] AS T2 ON T1.field1 = T2.field1 And T1.Field2 = T2.Field2 And T1.Field3 = T2.Field3 SET T1.field4 = T2.field4; "

you must supply the correct fieldnames for each table.

 

[Ranman256]

dont update data via code, always use queries.

 

[mfaqueiroz]

Thank you arnelgp, i will try this now!! seems an interesting way to do this task!

Ranman, how can i do this using queries?

 

[mfaqueiroz]

Arnelpg,
thank you so so much! you have revolutionized the way that i programme on vba!!
You really added quality to my work!!
thaanks!!

 

[arnelgp]

did it worked? you're always welcome!

 

[mfaqueiroz]

Yeees! 4 hours running to some seconds!!! perfect!

 

[mfaqueiroz]

I've also other code that is really slow, do you have any suggestion how can i speed it?
The objective is more complex than the other.
-I have one table with a lot of machine registers, I've the status(could be off,on, alarm, in course, programmed....) the date ( dd-mm-yyyy hh:mm:ss) and the code (could be 1,2,3).
-I've a decision tree where i analyse the code 4 seconds before one register with the satatus off:
-If i have one 1,2,3 or we have 2 and 3 in this time interval I classified as " PreventiveMaintenance"
-If i have one 1 and 3 in this time interval i classfied as "CorrectiveMaintenance"
(...i have more conditions but for what i want i think that this two works)

So, I've the following code, that is taking hours to process:

Sub 4secondsOff_Classification()

Set dbs = DBEngine(0)(0)
Set WriteTable = dbs.OpenRecordset("WriteTable", DB_OPEN_DYNASET) 'This is where i will write the classication
Set OFF = dbs.OpenRecordset("SELECT INPU.[ID], Input.[My date], Input.[Machine],Input.[Status]='OFF', Input.

 FROM Input ORDER BY Input.[Rtu date];", DB_OPEN_DYNASET) 'Here I will create one table only with off registers


      OFF.MoveFirst
    Do While Not Off.EOF
    
	Cont1 = 0
    Cont2 = 0
    Cont3 = 0
    
       RtuDate = Off.Fields(2).Value
       Machine = Off.Fields(3).Value 'Machine
       id = Off.Fields(0).Value  'ID
       RtuDate1 = Mid(Off.Fields(2).Value, 7, 4) & "-" & Mid(Off.Fields(2).Value, 4, 2) & "-" & Mid(Off.Fields(2).Value, 1, 2) & " " & Right(Off.Fields(2).Value, 8) 'date on SQL mode
       Dif4seconds = DateAdd("s", -4, RtuDate) '4 seconds before the off
       DataComp = Mid(Diferenca35, 7, 4) & "-" & Mid(Diferenca35, 4, 2) & "-" & Mid(Diferenca35, 1, 2) & " " & Right(Diferenca35, 8) ' Date 4 seconds before organized on SQL mode
           
		' I will create 3 queries, they will give the registers with code 1,2 and 3 respectively in the time intervall between the time of the OFF register and the time 4 seconds before 
       Set Tab1 = dbs.OpenRecordset("SELECT TabInst.ID, TabInst.[Rtu date], TabInst.Machine, TabInst.Code FROM TabInst WHERE (((TabInst.[Rtu date])<=#" & RtuDate1 & "#) AND (((TabInst.[Rtu date])>= #" & DataComp & "#))) And TabInst.Code = '1' AND TabInst.[Machine] = '" & Machine & "' ORDER BY TabInst.[Rtu date];", DB_OPEN_DYNASET)
       Set Tab2 = dbs.OpenRecordset("SELECT TabInst.ID, TabInst.[Rtu date], TabInst.Machine, TabInst.Code FROM TabInst WHERE (((TabInst.[Rtu date])<=#" & RtuDate1 & "#) AND (((TabInst.[Rtu date])>= #" & DataComp & "#))) And TabInst.Code = '2' AND TabInst.[Machine] = '" & Machine & "' ORDER BY TabInst.[Rtu date];", DB_OPEN_DYNASET)
	   Set Tab3 = dbs.OpenRecordset("SELECT TabInst.ID, TabInst.[Rtu date], TabInst.Machine, TabInst.Code FROM TabInst WHERE (((TabInst.[Rtu date])<=#" & RtuDate1 & "#) AND (((TabInst.[Rtu date])>= #" & DataComp & "#))) And TabInst.Code = '3' AND TabInst.[Machine] = '" & Machine & "' ORDER BY TabInst.[Rtu date];", DB_OPEN_DYNASET)
		 
       'Then i will count the registers that i have in each table of code 1 code 2 and code 3! 
       
       If Tab1.RecordCount <> 0 Then
       Tab1.MoveFirst
        Do While Not Tab1.EOF
            If (Tab1.Fields(0).Value < id)) Then
            Cont1 = 1 + Cont1
            End If
            Tab1.MoveNext
            Loop
            End If
        
        
        If Tab2.RecordCount <> 0 Then
        Tab2.MoveFirst
        Do While Not Tab2.EOF
            If (Tab2.Fields(0).Value < id) Then
            Cont2 = 1 + Conta2
            End If
            Tab2.MoveNext
            Loop
            End If
        
        If Tab3.RecordCount <> 0 Then
        Tab3.MoveFirst
        Do While Not Tab3.EOF
            If (Tab3.Fields(0).Value < id)  Then
            Cont3 = 1 + Cont3
            End If
            Tab3.MoveNext
            Loop
            End If
        
  
            
            'Then I will atribute for each case the classifcation
            If (Cont1 <> 0 And Cont2 <> 0 And Conta3 <> 0) and (Conta3 <> 0) or ((Cont1 = 0 And Cont2 <> 0 And Conta3 <> 0) and (Conta3 <> 0))  Then 'Preventive
            WriteTable.AddNew
            WriteTable.Fields(1).Value = id
            WriteTable.Fields(2).Value = "PreventiveMaintenance"
            WriteTable.Update
            
            ElseIf (Conta1 <> 0 And Conta2 = 0 And Conta3 <> 0) Then 'Corrective
             WriteTable.AddNew
            WriteTable.Fields(1).Value = id
            WriteTable.Fields(2).Value = "CorrectiveMaintenance"
            WriteTable.Update
            
            Else 'Unknown
            WriteTable.AddNew
            WriteTable.Fields(1).Value = id
            WriteTable.Fields(2).Value = "Unknown"
            WriteTable.Update
            End If
            
     
                 
                        
            
                End If
          
           Off.MoveNext
           Loop
           End Sub

Anyone have some sugestions how can i improve this code? :)
thank you so much!!

 

[arnelgp]

I will see further if we can reduce the code and covert to sql, in the meantime i manage to trim some of the code

Sub 4secondsOff_Classification()
    
    Dim ws As DAO.Workspace
    Set dbs = DBEngine(0)(0)
    Set ws = DBEngine.Workspaces(0)
    
    ws.BeginTrans
    Set WriteTable = dbs.OpenRecordset("WriteTable", DB_OPEN_DYNASET) 'This is where i will write the classication
    Set Off = dbs.OpenRecordset("SELECT INPU.[ID], Input.[My date], Input.[Machine] WHERE Input.[Status]='OFF' FROM Input ORDER BY Input.[Rtu date];", DB_OPEN_DYNASET) 'Here I will create one table only with off registers
    
    
    If Not (Off.BOF And Off.EOF) Then Off.MoveFirst
    Do While Not Off.EOF
    
        Cont1 = 0
        Cont2 = 0
        Cont3 = 0
        
        RtuDate = Off.Fields(2).Value
        Machine = Off.Fields(3).Value 'Machine
        ID = Off.Fields(0).Value 'ID
        RtuDate1 = Mid(Off.Fields(2).Value, 7, 4) & "-" & Mid(Off.Fields(2).Value, 4, 2) & "-" & Mid(Off.Fields(2).Value, 1, 2) & " " & Right(Off.Fields(2).Value, 8) 'date on SQL mode
        Dif4seconds = DateAdd("s", -4, RtuDate) '4 seconds before the off
        DataComp = Mid(Diferenca35, 7, 4) & "-" & Mid(Diferenca35, 4, 2) & "-" & Mid(Diferenca35, 1, 2) & " " & Right(Diferenca35, 8) ' Date 4 seconds before organized on SQL mode
        
        ' I will create 3 queries, they will give the registers with code 1,2 and 3 respectively in the time intervall between the time of the OFF register and the time 4 seconds before
        Cont1 = Nz(DCount("*", "TabInst", "TabInst.ID = " & ID & " AND (((TabInst.[Rtu date])<=#" & RtuDate1 & "#) AND (((TabInst.[Rtu date])>= #" & DataComp & "#))) And TabInst.Code = '1' AND TabInst.[Machine] = '" & Machine & "'"), 0)
        Cont2 = Nz(DCount("*", "TabInst", "TabInst.ID = " & ID & " AND (((TabInst.[Rtu date])<=#" & RtuDate1 & "#) AND (((TabInst.[Rtu date])>= #" & DataComp & "#))) And TabInst.Code = '1' AND TabInst.[Machine] = '" & Machine & "'"), 0)
        Cont3 = Nz(DCount("*", "TabInst", "TabInst.ID = " & ID & " AND (((TabInst.[Rtu date])<=#" & RtuDate1 & "#) AND (((TabInst.[Rtu date])>= #" & DataComp & "#))) And TabInst.Code = '1' AND TabInst.[Machine] = '" & Machine & "'"), 0)
        
        'Then I will atribute for each case the classifcation
        With WriteTable
            .AddNew
            .Fields(1).Value = ID
            If (Cont1 <> 0 And Cont2 <> 0 And Cont3 <> 0) Or (Cont1 = 0 And Cont2 <> 0 And Cont3 <> 0) Then 'Preventive
                .Fields(2).Value = "PreventiveMaintenance"
            
            ElseIf (Conta1 <> 0 And Cont2 = 0 And Cont3 <> 0) Then 'Corrective
                .Fields(2).Value = "CorrectiveMaintenance"
            
            Else 'Unknown
                .Fields(2).Value = "Unknown"
            End If
            .Update
        End With
        Off.MoveNext
    Loop
    ws.CommitTrans
    ws.Close
    Set ws = Nothing
End Sub

 

[mfaqueiroz]

Hi,
thank you for your help great tips!
I have a simple doubt about sql, how is the best way to write values on an existing table?

Something that i will do in vba in this generic way:

Me!Table.AddNew
Me!Table.Fields(1).Value = Me!Tab1.Fields(1).Value
Me!Table.Fields(2).Value = "Yes"
Me!Table.Fields(4).Value = "Ok"
Me!Table.Fields(5).Value = Me!Tab1.Fields(6).Value
Me!Table.Fields(6).Value = Me!Tab1.Fields(8).Value
Me!Table.Fields(7).Value = Me!Tab1.Fields(9).Value
Me!Table.Update


I sincerely appreciate the time you spent reviewing my code and your interest in giving more knowledge to the community!