Out Of Range

[lixfelix123]

I'm trying to upload some excel file into sql server this is my second file to upload,i'm using same code for first file and its working but not for this file

this is my code for first file

Dim filetoopen As Variant
Dim opeenbook As Workbook

filetoopen = Application.GetOpenFilename(Title:="Browse For Your File", FileFilter:="Excel Files(*.xlsx),*xls*")

If filetoopen <> False Then


    Application.ScreenUpdating = False

    Set opeenbook = Application.Workbooks.Open(filetoopen)
  



End If



Dim conn As ADODB.Connection
Dim cs As String
Dim sqlcmd As String


Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "SERVER=FELIX"


conn.Open cs, "", ""
sqlcmd = "CREATE DATABASE MAGANG"

conn.Execute sqlcmd

conn.Close




Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"

conn.Open cs, "", ""


sqlcmd = "CREATE TABLE Detail_Data(ID Varchar(255) PRIMARY KEY, MODE Varchar(255),ORIGIN Varchar(255),HWBL Varchar(255),[CONTAINER 20] INT,[CONTAINER 40] INT,VOLUME VARCHAR(255),[GROSS WEIGHT] Varchar(255),[CHARGEABLE WEIGHT] Varchar(255));"


conn.Execute sqlcmd
conn.Close
Set conn = Nothing


Workbooks("Detail_Data").Sheets("3-Detail_Data").Cells.Select
With Workbooks("Detail_Data").Worksheets("3-Detail_Data").Sort

.SetRange Range("A:I")
.Header = xlYes
.Orientation = xlTopToBottom
.Apply

End With

lr = Workbooks("Detail_Data").Worksheets("3-Detail_Data").Cells(Rows.Count, 1).End(xlUp).Row

For i = lr To 2 Step by - 1
If Worksheets("3-Detail_Data").Cells(i, 1).Value = Worksheets("3-Detail_Data").Cells(i - 1, 1).Value Then
Worksheets("3-Detail_Data").Rows(i).Select
Selection.Delete shift:=xlUp
End If

Next

    Dim l_row As Long
  
    Dim s_MODE As String
    Dim s_ORIGIN As String
    Dim s_ID As String
  
    Dim s_HWBL As String
    Dim s_CONTAINER20 As Integer
    Dim s_CONTAINER40 As Integer
  
    Dim s_VOLUME As String
    Dim s_GROSSWEIGHT As String
    Dim s_CHARGEABLEWEIGHT As String



Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"



    With Workbooks("Detail_Data").Sheets("3-Detail_Data")

conn.Open cs, "", ""
        l_row = last_row_with_data(1, ActiveSheet)
  
    For i = 2 To l_row
            
        s_ID = .Cells(i, 1)
        s_MODE = .Cells(i, 2)
        s_ORIGIN = .Cells(i, 3)
        s_HWBL = .Cells(i, 4)
        s_CONTAINER20 = .Cells(i, 5)
        s_CONTAINER40 = .Cells(i, 6)
        s_VOLUME = .Cells(i, 7)
        s_GROSSWEIGHT = .Cells(i, 8)
        s_CHARGEABLEWEIGHT = .Cells(i, 9)
                              
        sqlcmd = "insert into dbo.Detail_Data (ID, MODE, ORIGIN,HWBL,[CONTAINER 20],[CONTAINER 40],VOLUME,[GROSS WEIGHT],[CHARGEABLE WEIGHT]) values ('" & s_ID & "', '" & s_MODE & "', '" & s_ORIGIN & "','" & s_HWBL & "','" & s_CONTAINER20 & "','" & s_CONTAINER40 & "','" & s_VOLUME & "','" & s_GROSSWEIGHT & "','" & s_CHARGEABLEWEIGHT & "')"
        conn.Execute sqlcmd
         Next
          conn.Close
        Set conn = Nothing

    End With
  

    Workbooks("Detail_Data").Close savechanges:=False
End Sub

===============AND This code not working==============

Private Sub MasterData_Click()

Dim filetoopen2 As Variant
Dim opeenbook2 As Workbook

filetoopen2 = Application.GetOpenFilename(Title:="Browse For Your File", FileFilter:="Excel Files(*.xlsx),*xls*")

If filetoopen2 <> False Then


    Application.ScreenUpdating = False

    Set opeenbook2 = Application.Workbooks.Open(filetoopen2)
  
End If

Dim conn As ADODB.Connection
Dim cs As String
Dim sqlcmd As String


Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "SERVER=FELIX"


conn.Open cs, "", ""
On Error GoTo errr
sqlcmd = "CREATE DATABASE MAGANG"

conn.Execute sqlcmd

conn.Close



errr:
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"

conn.Open cs, "", ""


sqlcmd = "CREATE TABLE Master_Data(HWBL varchar(255),ID Varchar(255) PRIMARY KEY, MWBL Varchar(255));"

On Error GoTo errormastertable
conn.Execute sqlcmd
conn.Close
Set conn = Nothing

errormastertable:


Workbooks("MasterData").Sheets("1-Master_Data").Cells.Select  <<<OUT OF RANGE
With Workbooks("MasterData").Worksheets("1-Master_Data").Sort

.SetRange Range("A:C")
.Header = xlYes
.Orientation = xlTopToBottom
.Apply

End With

lr = Workbooks("MasterData").Sheets("1-Master_Data").Cells(Rows.Count, 3).End(xlUp).Row

For i = lr To 2 Step by - 1
If Worksheets("1-Master_Data").Cells(i, 1).Value = Worksheets("1-Master_Data").Cells(i - 1, 1).Value Then
Worksheets("1-Master_Data").Rows(i).Select
Selection.Delete shift:=xlUp
End If

Next

'=====================================================================
'=====================================================================
'=====================================================================


Dim l_row As Long

Dim s_ID As String
Dim s_HWBL As String
Dim s_MWBL As String



Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"



With Workbooks("MasterData").Sheets("1-Master_Data")

conn.Open cs, "", ""
l_row = last_row_with_data(1, ActiveSheet)

For i = 2 To l_row


s_HWBL = .Cells(i, 1)
s_MWBL = .Cells(i, 2)
s_ID = .Cells(i, 3)



sqlcmd = "insert into dbo.Master_Data (HWBL, MWBL,ID) values ('" & s_HWBL & "', '" & s_MWBL & "', '" & s_ID & "')"
conn.Execute sqlcmd
Next
conn.Close
Set conn = Nothing

End With


Workbooks("MasterData").Close savechanges:=False

End Sub




Public Function last_row_with_data(ByVal lng_column_number As Long, shCurrent As Variant) As Long
last_row_with_data = shCurrent.Cells(Rows.Count, lng_column_number).End(xlUp).Row



End Function

 

[DanteAmor]

Workbooks("MasterData").Sheets("1-Master_Data").Cells.Select <<<OUT OF RANGE

You must have the "MasterData" book open.
The "MasterData" book must be active.
In the "MasterData" book you must have a sheet called "1-Master_Data" and the sheet must also be active.