Private Sub Assignsched(ByVal rType As String, ByVal subjectCode As String, ByVal SecID As String, ByVal CourseCode As String)
    If shrdcon.con.State = ConnectionState.Closed Then
        shrdcon.con.Open()
    End If
    Dim RoomNum As Integer
    dtARoom.Clear()
    Dim stoploop As Boolean

    Dim count As Integer = 0

    Dim rm1 As String
    RoomAssign = ""
    rm1 = "SELECT * FROM tblRoom WHERE RoomType = '" & rType & "'"
    Dim dat As New OleDbDataAdapter(rm1, shrdcon.con)
    dat.Fill(ds, "ARoom")




        stoploop = False
        count = 0
        Do Until stoploop = "True"
        RoomNum = rndm.Next(0, ds.Tables("ARoom").Rows.Count)
        RoomAssign = ds.Tables("ARoom").Rows(RoomNum).Item(1)

            ScheduleGeneration()

        If checkExisting(sTime, eTime, RoomAssign, daypick) = False Then


            RoomA = RoomAssign

            GenerateOfferingID()
            Dim cmd1 As New OleDbCommand()
            cmd1.CommandText = "INSERT INTO [tblSubjectOffer]([SubjectOID],[SubjectCode],[SectionID],[Day],[sTime],[eTime],[RoomName],[CourseCode]) VALUES('" & _
                                myId & "','" & subjectCode & "','" & SecID & "','" & daypick & "'," & sTime & "," & eTime & ",'" & RoomA & "','" & CourseCode & "')"
            cmd1.Connection = shrdcon.con
            cmd1.ExecuteNonQuery()
            cmd1.Dispose()

            Dim pipz As New OleDbCommand("Update tblGenerator Set NextNo='" & myId & "' where TableName ='" & "tblSubjectOffer" & "'", shrdcon.con)
            pipz.ExecuteNonQuery()
            pipz.Dispose()
            stoploop = True
        Else
            stoploop = False
        End If
            If stoploop = False Then

            If count = 30 Then
                stoploop = True
            Else

                count = count + 1

            End If
            End If
        Loop
End Sub

Private Sub Command1_Click()

    Dim myConnection As ADODB.Connection
    Dim rsData As ADODB.Recordset

    Set myConnection = New ADODB.Connection
    myConnection.ConnectionString = "xxxxxxxxxxxxxxxxxxxx"
    myConnection.Open

    Set rsData = New ADODB.Recordset
    rsData.CursorLocation = adUseClient
    rsData.Open "select * from mytable", myConnection, adOpenStatic, adLockBatchOptimistic

    For i = 1 To 10000
        rsData.AddNew
        rsData.Fields(0).Value = 1
        rsData.Fields(1).Value = 2
    Next i

    rsData.UpdateBatch

    rsData.Close
    myConnection.Close
    Set rsData = Nothing
End Sub

For i = 0 To DataGridView1.RowCount - 1


            reg = DataGridView1.Rows(i).Cells(0).Value
            Label2.Text = reg

'i added this two lines
            ***con.Close()***
            ***Call conState()***

            Dim cmdcheck As New OleDbCommand("Select * from [2015/2016 UG CRF] where regno ='" & reg & "'", con)
            Dim drcheck As OleDbDataReader
            drcheck = cmdcheck.ExecuteReader
            If drcheck.Read = True Then

                GoTo A

            End If

            coursesFirst = String.Empty
            coursesSecond = String.Empty
            creditFirst = 0
            creditSecond = 0
            Dim cmdlevel As New OleDbCommand("Select * from [2015/2016 UG registration Biodata 5 april 16] where regno ='" & reg & "'", con)
            Dim drlevel As OleDbDataReader
            drlevel = cmdlevel.ExecuteReader

            If drlevel.Read = True Then
                level = drlevel.Item("level").ToString
                faculty = drlevel.Item("faculty").ToString
                program = drlevel.Item("programme").ToString

            End If

...............

next

Public Sub conState()
        If con.State = ConnectionState.Closed Then
            con.Open()

        End If

    End Sub

OleDbDataReader reader = cmd.ExecuteReader();
bool result = reader.Read();
reader.Close(); // <= Problem went away after adding this
return result;