Update multiple records in SQL using Excel VBA-CodePudding

Hello I doing an update from Excel to SQL but the code only works for 1 row. I want to update multiple rows or you could say all rows which are on Excel I have loaded

see the below code

VBA Code:
Sub UpdateTable()
Dim cnn As ADODB.Connection
Dim uSQL As String

Dim LR, LC As Long
Dim Group, Category As String
Dim itcode As Integer
' this is only for active cell i want for all cell in sheet which is on A column
Dim rngname As Range
Set rngname = ActiveCell
Set cnn = New Connection
        itcode = ShCustomers.Cells(rngname.row, 1)
        Group = "'" & ShCustomers.Cells(rngname.row, 2) & "'"
         Category = "'" & ShCustomers.Cells(rngname.row, 3) & "'"
cnnstr = "Provider=SQLOLEDB; Data Source=MAK-SYS;Initial Catalog=db_bckupserver_test_sys;User ID=sa;Password=Rehman@123;Trusted_Connection=No"
cnn.Open cnnstr
uSQL = "UPDATE mak_items_chart SET [Group] = " & Group & " WHERE itcode =  " & itcode
cnn.Execute uSQL
cnn.Close
Set cnn = Nothing

End Sub

I want to loop it but I don't understand how I can add a loop which will update all the records into SQL

Here is the image with modified code

Please see the below image

CodePudding user response：

My assumption is that we only need the sheet with the codename ShCustomers. Then my suggestion would be

Sub UpdateTable()
    Dim cnn As ADODB.Connection
    Dim uSQL As String

    Dim LR, LC As Long
    Dim Group As String, Category As String  ' I fixed the declaration
    Dim itcode As Integer
    Dim rngname As Range
    
    Set cnn = New Connection
    cnnstr = "Provider=SQLOLEDB; Data Source=MAK-SYS;Initial Catalog=db_bckupserver_test_sys;User ID=sa;Password=Rehman@123;Trusted_Connection=No"
    cnn.Open cnnstr
    
    Set rngname = getColA(ShCustomers)
    
    Dim sngCell As Range
    For Each sngCell In rngname
        
        ' you have to check if the values make sense
        ' What about empty cells
        itcode = sngCell.Value
        Group = "'" & sngCell.Offset(, 1).Value & "'"
        Category = "'" & sngCell.Offset(, 2).Value & "'"
        
        uSQL = "UPDATE mak_items_chart SET [Group] = " & Group & " WHERE itcode =  " & itcode
        cnn.Execute uSQL
    Next sngCell
    
    cnn.Close
    Set cnn = Nothing

End Sub

You need to add the following functions

Function getColA(ws As Worksheet) As Range
    Dim rng As Range
        
    Dim lastRow As Long
    lastRow = FindLastRow(ws.Columns(1))
    
    With ws
        Set rng = Range(.Cells(1, 1), .Cells(lastRow, 1))
    End With
    Set getColA = rng
End Function
Function FindLastRow(rg As Range) As Long
    
    On Error GoTo EH
    
    FindLastRow = rg.Find("*", , Lookat:=xlPart, LookIn:=xlFormulas _
        , searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Exit Function

EH:
    FindLastRow = rg.Cells(1, 1).Row

End Function