VBA GoTo: Will this work?

Peter h

Active Member
Joined
Dec 8, 2015
Messages
417
I'm working on a data entry form that I made for work, that enters data into a webform on our network, so it's hard for me to do too much code testing since the data gets uploaded to our network. My entry form has been working good, but I've heard from a few users that every once in a while (Seems random) the data doesn't get entered into the webform. No errors occur, and the code goes through as if everything is ok, but when you look at the entered data on the webform it isn't there. I don't know if there are hickups in the network that is causing random sets of data to not be entered or what is going on, but I'm trying to fix this issue using my code.

So, a on the webform there is a listbox (listbox1) that is a list of times that represents a set of data that was entered. When I enter a set of data into the form, the listbox updates with the newest data set being the first item in the listbox. So, my solution to verify whether or not the data was sent from my userform to the webform, I'm checking the first item in that listbox with the cell in the lastrow of the worksheet I'm storing my data on. And currently if they don't match I just have a messagebox pop up saying that the data wasn't entered on the webform.

I was wondering if, instead of a message box, if I could just have it retry to enter the data by having a GoTo statement that sends the code back up to where it enters the data. Does this work jumping between subs? Is there a better way I should be doing this? Thanks for any help or advice you can give me.

Code:
Private Sub btn_submit_Click()
Dim IE As InternetExplorerMedium
Dim targetURL As String
Dim lastrow As Long, ws As Worksheet
Dim x, Cx As String
Dim selectElement As HTMLSelectElement
Dim optionIndex As Integer
For i = 0 To 6
If lb_type.Selected(i) = True Then
targetURL = "[I][URL="http://miap33wsapx16/asoma/asomaentryform.aspx"]MyLink[/URL][/I]"
Set IE = New InternetExplorerMedium
    IE.Visible = False ' Set to true to watch what's happening
    IE.Navigate targetURL
    Do Until IE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
         IE.Document.getElementById("ddlSelection").selectedIndex = lb_type.ListIndex + 1
         IE.Document.getElementById("ddlSelection").FireEvent ("onchange")
        
        Do
            DoEvents
        Loop While IE.Document.getElementById("Sample_Arrival_Time") Is Nothing And IE.Document.getElementById("btnOK") Is Nothing
    
    If Not IE.Document.getElementById("btnOK") Is Nothing Then
        MsgBox "There seems to be an issue connecting to the Pi Server." & vbNewLine & _
        "Please check the old entry form to make sure there are no network issues."
        GoTo EH
    End If
End If
Next I


[COLOR=#FF0000]tryagain:[/COLOR]
Set efs = IE.Document
    With efs
        .getElementById("Sample_Arrival_Time").Value = tb_arrivaltime.Value
        .getElementById("SampleTaken").Value = tb_sampletime.Value
        .getElementById("Control_Room_Operator").selectedIndex = cb_cro.ListIndex + 1
        .getElementById("Analyst").selectedIndex = cb_analyst.ListIndex + 1
        .all("Copper").Value = tb_cu.Value   'Cu
        .all("Iron").Value = tb_fe.Value   'Fe
        .all("Sulfur").Value = tb_s.Value   'S
        .all("Silica").Value = tb_si.Value   'Si
        .all("Lime").Value = tb_ca.Value   'Ca
        .all("Alumina").Value = tb_al.Value   'Al
        .all("Magnetite").Value = tb_mag.Value   'mag
    End With
        If chb_ave = False Then
            efs.getElementById("Incl_Daily_Average").Click
        End If
        efs.getElementById("btnAccept").Click    'Activate this when code is working
    
Set efs = Nothing
Set IE = Nothing
CheckEntered
Code:
Private Sub CheckEntered()
Dim IE As InternetExplorerMedium
Dim targetURL As String
Dim lastrow As Long, ws As Worksheet
Dim selectElement As HTMLSelectElement
Dim optionIndex As Integer
targetURL = "[I][URL="http://miap33wsapx16/asoma/asomaentryform.aspx"]MyLink[/URL][/I]"
Set IE = New InternetExplorerMedium
    IE.Visible = False ' Set to true to watch what's happening
    IE.Navigate targetURL
    Do Until IE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
For i = 0 To 6
If lb_type.Selected(i) = True Then
         IE.Document.getElementById("ddlSelection").selectedIndex = lb_type.ListIndex + 1
         IE.Document.getElementById("ddlSelection").FireEvent ("onchange")
        
        Do
            DoEvents
        Loop While IE.Document.getElementById("Sample_Arrival_Time") Is Nothing And IE.Document.getElementById("btnOK") Is Nothing
    
    If Not IE.Document.getElementById("btnOK") Is Nothing Then
        MsgBox "There seems to be an issue connecting to the Pi Server." & vbNewLine & _
        "Please check the old entry form to make sure there are no network issues."
        Exit Sub
    End If
    Exit For
End If
Next i
Set ws = ThisWorkbook.Sheets(i + 2)
lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
Set selectElement = IE.Document.getElementById("ListBox1")
optionIndex = FindSelectOptionIndex(selectElement, ws.Cells(lastrow, 3).Text)
    If optionIndex <> 1 Then
        MsgBox (ws.Cells(lastrow, 3).Text & " Sample was not entered into Pi. ")
        [COLOR=#FF0000]GoTo tryagain[/COLOR]
    End If
 
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
I forgot to add that I have this function. That might make the second sub make a little more sense.

Code:
Private Function FindSelectOptionIndex(selectElement As HTMLSelectElement, findOptionText As String) As Integer
    Dim i As Integer
    
    FindSelectOptionIndex = -1
    i = 0
    While i < selectElement.Options.Length And FindSelectOptionIndex = -1
        Debug.Print i, selectElement.Item(i).Value & " >" & selectElement.Item(i).Text & "<"
        If LCase(selectElement.Item(i).Text) = LCase(findOptionText) Then FindSelectOptionIndex = i
        i = i + 1
    Wend
    
End Function
 
Upvote 0

Forum statistics

Threads
1,224,845
Messages
6,181,301
Members
453,031
Latest member
Chris_1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top