This question already has answers here:
What is an IndexOutOfRangeException / ArgumentOutOfRangeException and how do I fix it?
(5 answers)
Closed 2 years ago.
i've tried the other solution(like changing item that should be shown on data) but i think i've never gotten the point to resolving. Thank you in advance whoever can answer my problem...
Private Sub dgEmp_Click(sender As Object, e As EventArgs) Handles dgEmp.Click
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End Sub
Private Sub LoadEmployee(Optional q As String = "")
list.Query = "Select id,lastname,firstname,middlename,sss,philh,pag,rate,cola,mStatus,free_insurance,mp,mpvalue from tblemployee where (lastname like'%" & q & "%' or firstname like'%" & q & "%' or middlename like'%" & q & "%') and deactive='No' order by lastname,firstname,middlename"
list.datagrid = dgEmp
list.LoadRecords()
If list.RecordCount = Nothing Then Exit Sub
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End Sub
Public Sub LoadEmployeeInfo(index As Integer)
With dgEmp.Rows(index)
id = .Cells(0).Value
lblName.Text = .Cells(1).Value & ", " & .Cells(2).Value & " " & .Cells(3).Value
rpd = .Cells(7).Value
lblRate.Text = Format(rpd, "#,##0.000000000")
cola = .Cells(8).Value
lblAllo.Text = Format(cola, "#,##0.000000000")
otrate = (rpd / 8) * 1.25
lblOTRate.Text = Format(otrate, "#,##0.000000000")
IsSSS = ConvertToBoolean(.Cells(4).Value)
IsPH = ConvertToBoolean(.Cells(5).Value) 'add
IsPAG = ConvertToBoolean(.Cells(6).Value) 'pos
IsMP = ConvertToBoolean(.Cells(11).Value)
IsFI = ConvertToBoolean(.Cells(10).Value)
CStatus = .Cells(9).Value
MPV = .Cells(12).Value
End With
ThisPayroll.Query = "Select * from tblpayroll where payrollperiod=? and empid=?"
ThisPayroll.AddParam("#payrollperiod", GetPeriod)
ThisPayroll.AddParam("#empid", id)
ThisPayroll.ExecQuery()
If ThisPayroll.RecordCount = Nothing Then
isUpdate = False
txtReg_Days.Text = 0
txtReg_OT.Text = 0
txtSP_Days.Text = 0
txtSP_OT.Text = 0
txtHoliday.Text = 0
txtHolidayOT.Text = 0
txtLate.Text = 0
txtAdjustment.Text = 0
txtSSSL.Text = 0
txtHDMFL.Text = 0
txtCA.Text = 0
txtDMA.Text = 0
txtRice.Text = 0
txtCloth.Text = 0
txtEmpMed.Text = 0
txtLaundry.Text = 0
txtMeal.Text = 0
Else
With ThisPayroll.DataSource
isUpdate = True
txtReg_Days.Text = .Rows(0)("regday")
txtReg_OT.Text = .Rows(0)("ot")
txtSP_Days.Text = .Rows(0)("spday")
txtSP_OT.Text = .Rows(0)("spdayot")
txtHoliday.Text = .Rows(0)("lholiday")
txtHolidayOT.Text = .Rows(0)("lhot")
txtLate.Text = .Rows(0)("hlate")
txtAdjustment.Text = .Rows(0)("salary_adj")
txtSSSL.Text = .Rows(0)("sss_loan")
txtHDMFL.Text = .Rows(0)("pag_loan")
txtCA.Text = .Rows(0)("cash_advance")
txtDMA.Text = .Rows(0)("depmed")
txtRice.Text = .Rows(0)("ricesub")
txtCloth.Text = .Rows(0)("clothing")
txtEmpMed.Text = .Rows(0)("empmed")
txtLaundry.Text = .Rows(0)("laundry")
txtMeal.Text = .Rows(0)("meal")
End With
End If
Compute()
End Sub
If you cannot make sure that something is selected elsewhere, you can last-minute check it like this:
Private Sub DataGridView1_SelectionChanged(sender As Object, e As EventArgs) Handles DataGridView1.SelectionChanged
If dgEmp.SelectedRows.Count > 0 Then
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End If
End Sub
It works only because you're using index zero, or else you would have to be careful for your index, too. Of course, this is assuming that dgEmp is not Nothing...
Also, notice that I attached this to the SelectionChanged event, as I don't think that the Click event will give you what you want, but I'll let that part for you to deal with. Have fun!
I am trying to lookup a value in a table for a particular patient ID and see whether that patient has the value Resistant. If so then disable a particular button on the form. I tried the following dlookup but it's giving me compiler error:
If DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID) = Resistant Then
Me.btnDSTMatch.Enabled = True
Else
Me.btnDSTMatch.Enabled = False
Try with:
If DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID & "") = "Resistant" Then
Me.btnDSTMatch.Enabled = True
Else
Me.btnDSTMatch.Enabled = False
End If
Or perhaps directly:
Me.btnDSTMatch.Enabled = IsNull(DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID & " And [Rifampicin] = 'Resistant'"))
To filter on the latest date you can include a DMax expression or (the little known option) an SQL filter:
Me.btnDSTMatch.Enabled = IsNull(DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID & " And [Rifampicin] = 'Resistant' And [JournalDate] = (Select Max([JournalDate]) From TableGeneXpert Where [PatientID] = " & Forms.FrmTreatment!PatientID & " And [Rifampicin] = 'Resistant')"))
I need to import 'contacts' into my database from several external sources.
Some 'contacts' may already exist so I only need 'new' data.
I've written an update records code however it will overwrite all data therefore damaging the integrity of the table as the old data may contain some valid values.
I tried using an update/append query however this only OVERWROTE the values of the original field not UPDATED IF OLD VALUE WAS NULL/FALSE ONLY. The issue with this is it will apply/remove profile flags that result in correspondence and data usage (Incorrect update = potential breach of GDPR).
I can't program in SQL, I understand how the functions work and what they do but not how to compile/what order (yet) hence using VBA for now.
Dim myR As Recordset
Dim myR2 As Recordset
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
Else
myR2.Edit
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
End If
myR.MoveNext
Loop
Set myR = Nothing
End Sub
Is there a simpler way to write this or should I be utilising the code
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
For each value, creating effectively 15-20 subs and a macro to run all together?
I tried several code variations attempting to include elseIf, isNull() and isFalse() however they always failed to compile or no update was completed/records changed.
I need the code to do the following:
Check the contact exists in contacts table
If contact does not exist, add all data
If contact does exist, add new data or update yes/no fields from no to yes
NOTE: Currently 'contacts' table is empty as we need to create new/merge duplicates before the data is imported to the 'contacts' table.
So Contacts is currently:
Email Name Surname
- - -
- - -
- - -
- - -
Staging - Import is currently:
Email Name Surname
b#b.c Brad
t#b.c Tony Tiger
b#b.c B Pitt
r#b.c Ryan Reynolds
Contacts should look like this after completed:
Email Name Surname
t#b.c Tony Tiger
b#b.c Brad Pitt
r#b.c Ryan Reynolds
Determining what to update or add when comparing string data can be quite complicated and often involves case-by-case review. What rule should be applied to program decision to take "Brad" from one record and "Pitt" from other? What if data for the same email were: Brad Pitt and Bradley Pitt? Which is correct and should be saved? Probably have to do a query that finds duplicate emails in Staging and make case-by-case decision on what to fix/delete for these duplicates. Then insert to Contacts. Insert code can test content of each field for Null or False and determine whether to accept new value.
For non-yes/no field, use Nz() function (assumes text field will not have empty string)
myR2![First Name] = Nz(myR2![First Name], myR![First Name])
or (to deal with possible empty string)
If myR2![First Name] & "" = "" Then myR2![First Name] = myR![First Name]
(advise not to allow empty string in text field nor zero default value for number field in table design).
For yes/no field, test for False (do not set DefaultValue property in table design):
myR2![Supress] = IIf(myR2![Supress] = False, myR![Supress], True)
or
If myR2![Supress] = False Then myR2![Supress] = myR![Supress]
Shorter code for import procedure. Modify with the above.
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![WebSite] = myR![WebSite]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Supress]
myR2.Update
myR.MoveNext
Loop
Another, assuming recordsets have exactly same fields.
Dim myR As DAO.Recordset
Dim myR2 As DAO.Recordset
Dim fld As DAO.Field
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst "Email = '" & myR![Email] & "'"
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
For Each fld In myR.Fields
If fld.Name <> "Email" And _
(myR2.Fields(fld.Name) & "" = "" Or myR2.Fields(fld.Name) = False) Then
myR2.Fields(fld.Name) = fld
End If
Next
myR2.Update
myR.MoveNext
Loop
I'm working on an access project using vba and one of the programs has several queries like UPDATE A INNER JOIN B ON condition SET field = value .Both table A and Table B have hundreds of thousands records.
The annoying thing is these queries will take more than ten hours to execute and I was trying to use index to improve the performance but failed. Any suggestions to help me out?
Here is one of the queries:
strSQL = "UPDATE [csd_dis_" & i_year & "_all] as d INNER JOIN [adm_" & a_yyyy & "] as aa ON d.d_cino = aa.a_cino and cstr(d.d_sentdte) = cstr(aa.a_sentdte) and right('00' + trim(str(d.m_d_nature)),2) = left(trim(cstr(aa.m_a_nature)),2) "
strSQL = strSQL & "SET d.match_adm = " & kk & ",d.a_local_p = aa.a_local_p,d.inst = aa.c_inst, d.dosy = aa.dosy,d.dosm = aa.dosm,d.dosd = aa.dosd, " _
& "d.a_sentdte = aa.a_sentdte,d.tid = aa.tid,d.crb = aa.crb,d.crbchk = aa.crbchk, d.court = aa.court,d.ccn = aa.ccn,d.cyr = aa.cyr,d.a_nature = aa.nature,d.nature_o = aa.nature_o, " _
& "d.m_a_nature = aa.m_a_nature,d.class = aa.class,d.cat = aa.cat,d.ilossp = aa.ilossp,d.chap = aa.chap,d.sect = aa.sect,d.newoff = aa.newoff,d.hkid = aa.hkid,d.sex = aa.sex,d.doby = aa.doby,d.dobm = aa.dobm, " _
& "d.dobd = aa.dobd,d.a_dob = aa.a_dob,d.a_dob_imp = aa.a_dob_imp,d.age = aa.age,d.accom = aa.accom,d.disres = aa.disres,d.yrres = aa.yrres,d.edu = aa.edu,d.marst = aa.marst,d.bplbir = aa.bplbir,d.plbir = aa.plbir,d.yrhk = aa.yrhk, " _
& "d.[on] = aa.[on],d.sently = aa.sently,d.sentlm = aa.sentlm,d.sentld = aa.sentld,d.tr = aa.tr,d.dr = aa.dr,d.mr = aa.mr,d.inr = aa.inr,d.pvdg = aa.pvdg, d.pvndg = aa.pvndg,d.pvcn = aa.pvcn,d.pvcn2 = aa.pvcn2,d.bghome = aa.bghome, " _
& "d.pvdc = aa.pvdc,d.pvtc = aa.pvtc,d.pvdatc = aa.pvdatc,d.pvrc = aa.pvrc,d.pvpri = aa.pvpri,d.pvinst = aa.pvinst,d.foffen = aa.foffen,d.dfcy = aa.dfcy,d.dfcm = aa.dfcm,d.dfcd = aa.dfcd,d.a_dfcdte = aa.a_dfcdte, " _
& "d.agefcn = aa.agefcn,d.trisoc = aa.trisoc,d.ddpur = aa.ddpur,d.dcost = aa.dcost,d.cumd = aa.cumd,d.needle = aa.needle,d.yrdg = aa.yrdg,d.causa = aa.causa,d.fdg = aa.fdg,d.fmd = aa.fmd,d.agefdg = aa.agefdg, " _
& "d.yradd = aa.yradd,d.asso = aa.asso,d.la = aa.la,d.origin = aa.origin,d.mode = aa.mode,d.arrest = aa.arrest,d.stayy = aa.stayy,d.staym = aa.staym,d.stayd = aa.stayd,d.occ = aa.occ,d.name = aa.name,d.cname = aa.cname," _
& "d.othdocno = aa.othdocno,d.cudg1 = aa.cudg1,d.cudg2 = aa.cudg2,d.cudg3 = aa.cudg3,d.cudg4 = aa.cudg4,d.psydrug1 = aa.psydrug1,d.psydrug2 = aa.psydrug2,d.psydrug3 = aa.psydrug3, " _
& "d.psydrug4 = aa.psydrug4,d.agefpsy = aa.agefpsy,d.psydgfreq = aa.psydgfreq,d.psycausa = aa.psycausa WHERE '" & matchkey & "' and d.match_adm=' '"
I'm using Access 2010 VBA that is returning a recordset from an IBM iSeries. I have the following loop to append the recordset to a local table:
'Loop through recordset and place values
Do While rsti401.EOF = False
Set rst401 = CurrentDb.OpenRecordset("tblLocal_SL401WK", dbOpenDynaset, dbSeeChanges)
With rst401
.AddNew
.Fields("PC") = rsti401.Fields("PC")
.Fields("TIME") = rsti401.Fields("TIME")
.Fields("CONO") = rsti401.Fields("CONO")
.Fields("STYCOL") = rsti401.Fields("STYCOL")
.Fields("WHSE") = rsti401.Fields("WHSE")
.Fields("CUNO") = rsti401.Fields("CUNO")
.Fields("SIZE01") = rsti401.Fields("SIZE01")
.Fields("SIZE02") = rsti401.Fields("SIZE02")
.Fields("SIZE03") = rsti401.Fields("SIZE03")
.Fields("SIZE04") = rsti401.Fields("SIZE04")
.Fields("SIZE05") = rsti401.Fields("SIZE05")
.Fields("SIZE06") = rsti401.Fields("SIZE06")
.Fields("SIZE07") = rsti401.Fields("SIZE07")
.Fields("SIZE08") = rsti401.Fields("SIZE08")
.Fields("SIZE09") = rsti401.Fields("SIZE09")
.Fields("SIZE10") = rsti401.Fields("SIZE10")
.Fields("SIZE11") = rsti401.Fields("SIZE11")
.Fields("SIZE12") = rsti401.Fields("SIZE12")
.Fields("SIZE13") = rsti401.Fields("SIZE13")
.Fields("SIZE14") = rsti401.Fields("SIZE14")
.Fields("SIZE15") = rsti401.Fields("SIZE15")
.Fields("BQTY01") = rsti401.Fields("BQTY01")
.Fields("BQTY02") = rsti401.Fields("BQTY02")
.Fields("BQTY03") = rsti401.Fields("BQTY03")
.Fields("BQTY04") = rsti401.Fields("BQTY04")
.Fields("BQTY05") = rsti401.Fields("BQTY05")
.Fields("BQTY06") = rsti401.Fields("BQTY06")
.Fields("BQTY07") = rsti401.Fields("BQTY07")
.Fields("BQTY08") = rsti401.Fields("BQTY08")
.Fields("BQTY09") = rsti401.Fields("BQTY09")
.Fields("BQTY10") = rsti401.Fields("BQTY10")
.Fields("BQTY11") = rsti401.Fields("BQTY11")
.Fields("BQTY12") = rsti401.Fields("BQTY12")
.Fields("BQTY13") = rsti401.Fields("BQTY13")
.Fields("BQTY14") = rsti401.Fields("BQTY14")
.Fields("BQTY15") = rsti401.Fields("BQTY15")
.Update
End With
rsti401.MoveNext
Loop
'close connections
rsti401.Close
rst401.Close
IBM.Close
Set IBM = Nothing
Set rst401 = Nothing
Set rsti401 = Nothing
Set CMD = Nothing
However, each time I run it I is stopping at the following line:
rst401.Close
With error 'Run-time error 91'. I can't work it out. I've set rst401 at the beginning, so why am I still getting the error.
Any pointers would be a great help.
Thanks,
Michael
The problem you have is because the rst401 is set inside the Do While Loop, and you are trying to close an object that has lost its scope outside the Loop. Suggest you make the following changes.
'Loop through recordset and place values
Set rst401 = CurrentDb.OpenRecordset("tblLocal_SL401WK", dbOpenDynaset, dbSeeChanges)
Do While rsti401.EOF = False
With rst401
.AddNew
.Fields("PC") = rsti401.Fields("PC")
.Fields("TIME") = rsti401.Fields("TIME")
.Fields("CONO") = rsti401.Fields("CONO")
.Fields("STYCOL") = rsti401.Fields("STYCOL")
.Fields("WHSE") = rsti401.Fields("WHSE")
.Fields("CUNO") = rsti401.Fields("CUNO")
.Fields("SIZE01") = rsti401.Fields("SIZE01")
.Fields("SIZE02") = rsti401.Fields("SIZE02")
.Fields("SIZE03") = rsti401.Fields("SIZE03")
.Fields("SIZE04") = rsti401.Fields("SIZE04")
.Fields("SIZE05") = rsti401.Fields("SIZE05")
.Fields("SIZE06") = rsti401.Fields("SIZE06")
.Fields("SIZE07") = rsti401.Fields("SIZE07")
.Fields("SIZE08") = rsti401.Fields("SIZE08")
.Fields("SIZE09") = rsti401.Fields("SIZE09")
.Fields("SIZE10") = rsti401.Fields("SIZE10")
.Fields("SIZE11") = rsti401.Fields("SIZE11")
.Fields("SIZE12") = rsti401.Fields("SIZE12")
.Fields("SIZE13") = rsti401.Fields("SIZE13")
.Fields("SIZE14") = rsti401.Fields("SIZE14")
.Fields("SIZE15") = rsti401.Fields("SIZE15")
.Fields("BQTY01") = rsti401.Fields("BQTY01")
.Fields("BQTY02") = rsti401.Fields("BQTY02")
.Fields("BQTY03") = rsti401.Fields("BQTY03")
.Fields("BQTY04") = rsti401.Fields("BQTY04")
.Fields("BQTY05") = rsti401.Fields("BQTY05")
.Fields("BQTY06") = rsti401.Fields("BQTY06")
.Fields("BQTY07") = rsti401.Fields("BQTY07")
.Fields("BQTY08") = rsti401.Fields("BQTY08")
.Fields("BQTY09") = rsti401.Fields("BQTY09")
.Fields("BQTY10") = rsti401.Fields("BQTY10")
.Fields("BQTY11") = rsti401.Fields("BQTY11")
.Fields("BQTY12") = rsti401.Fields("BQTY12")
.Fields("BQTY13") = rsti401.Fields("BQTY13")
.Fields("BQTY14") = rsti401.Fields("BQTY14")
.Fields("BQTY15") = rsti401.Fields("BQTY15")
.Update
End With
rsti401.MoveNext
Loop
'close connections
rsti401.Close
rst401.Close
IBM.Close
Set IBM = Nothing
Set rst401 = Nothing
Set rsti401 = Nothing
Set CMD = Nothing