while updating data it takes to much time to update i have data in excel something 2000 rows and columns 40
Code:
Private Sub CommandButton1_Click()
Dim dbconn As New ADODB.Connection
Dim stDB, strConn
Dim totColumns, totRows, i, j, BMS_id, UpdateprBatchName, List, Msg
Dim prBatchName, prTableQry, inTableQry, prTableQry1, dbQry
Dim rs As New ADODB.Recordset
'Path to the database.
stDB = "mysql32"
'Create the connectionstring.
strConn = "Driver=MySQL ODBC 5.2 Unicode Driver;" _
& "Data Source=" & stDB & ";"
'With Sheet1
''Application.ScreenUpdating = True
'Cells.Locked = False
' Application.ScreenUpdating = False
' ActiveSheet.Unprotect "ka09z2507"
' ' unlock all the cells
' ' Selection.Locked = False
' Dim foundCol As Range
' Dim response As Variant
' response = Array("Itemnum", _
' "BMS_ID", _
' "FQR_User_code", _
' "Original Mfr Name", _
' "Original Mfr Part No", _
' "ORIGINAL SUPPLIER NAME", _
' "ORIGINAL SUPPLIER PART #", _
' "Original Description", _
' "Original Description 2", _
' "NOUN", _
' "MODIFIER", _
' "ATTRIBUTE NAME 1", _
' "ATTRIBUTE NAME 2", _
' "ATTRIBUTE NAME 3", _
' "ATTRIBUTE NAME 4", _
' "ATTRIBUTE NAME 5", _
' "ATTRIBUTE NAME 6", _
' "ATTRIBUTE NAME 7", _
' "ATTRIBUTE NAME 8", _
' "ATTRIBUTE NAME 9", _
' "ATTRIBUTE NAME 10", _
' "ATTRIBUTE NAME 11", _
' "ATTRIBUTE NAME 12", _
' "ATTRIBUTE NAME 13")
' For Each res In response
' Set foundCol = ActiveSheet.Rows(2).Find(res, LookIn:=xlValues, lookat:=xlColumns)
' Selection.Locked = True
' If Not foundCol Is Nothing Then
' ' Cells.Locked = True
' foundCol.EntireColumn.Locked = True
' Else
' MsgBox ("Column not found.")
' End If
' Next
' ActiveSheet.Protect "ka09z2507"
' Application.ScreenUpdating = True
'End With
Sheet1.Activate
'prBatchName = "tblprod_agr_007"
totColumns = ActiveSheet.Cells(2, 1).CurrentRegion.Columns.Count
totRows = ActiveSheet.Cells(3, 1).CurrentRegion.Rows.Count
'prBatchName = ActiveSheet.Cells(3, totColumns + 1).Values
dbconn.Open strConn
rs.CursorLocation = adUseServer
rs.Open "select * from " & update.txt1, dbconn, adOpenStatic, adLockOptimistic
For j = 3 To totRows + 1
BMS_id = ActiveSheet.Cells(j, 1)
rs.Find "BMS_ID='" & BMS_id & "'"
For i = 2 To totColumns
rs(ActiveSheet.Cells(2, i).Value) = ActiveSheet.Cells(j, i)
Next
rs.update
Next
rs.Close
dbconn.Close
Application.ScreenUpdating = True
MsgBox "Data updated sucessfully"
Cells.Locked = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect "ka09z2507"
' unlock all the cells
' Selection.Locked = False
' Dim foundCol As Range
' Dim response As Variant
response = Array("Itemnum", _
"BMS_ID", _
"FQR_User_code", _
"Original Mfr Name", _
"Original Mfr Part No", _
"ORIGINAL SUPPLIER NAME", _
"ORIGINAL SUPPLIER PART #", _
"Original Description", _
"Original Description 2", _
"NOUN", _
"MODIFIER", _
"ATTRIBUTE NAME 1", _
"ATTRIBUTE NAME 2", _
"ATTRIBUTE NAME 3", _
"ATTRIBUTE NAME 4", _
"ATTRIBUTE NAME 5", _
"ATTRIBUTE NAME 6", _
"ATTRIBUTE NAME 7", _
"ATTRIBUTE NAME 8", _
"ATTRIBUTE NAME 9", _
"ATTRIBUTE NAME 10", _
"ATTRIBUTE NAME 11", _
"ATTRIBUTE NAME 12", _
"ATTRIBUTE NAME 13")
For Each res In response
Set foundCol = ActiveSheet.Rows(2).Find(res, LookIn:=xlValues, lookat:=xlColumns)
Selection.Locked = True
If Not foundCol Is Nothing Then
' Cells.Locked = True
foundCol.EntireColumn.Locked = True
' Else
' MsgBox ("Column not found.")
End If
Next
ActiveSheet.Protect "ka09z2507"
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, Password:="ka09z2507", AllowFiltering:=True, AllowFormattingCells:=True, AllowUsingPivotTables:=True, AllowFormattingColumns:=True, userInterfaceOnly:=True, AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, AllowSorting:=True
Unload update
End Sub
