1
Need a little help please! I am getting runtime error 3001 at oRS.filter = ("RM TYP = '" & cell.Text & "'")
Private Sub CommandButton5_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim oRS As New ADODB.Recordset
Dim oCN As New ADODB.Connection
With oCN
.Provider = "Microsoft.jet.oledb.4.0"
.CursorLocation = adUseClient
.Open "C:\HC_MDB\HC_DB_ACC.mdb"
End With
With oRS
.LockType = adLockOptimistic
.CursorType = adOpenDynamic
.ActiveConnection = oCN
.Open "Select * from INFO"
Set wsHC = ThisWorkbook.Worksheets("RS")
MsgBox wsHC.Range("E14", wsHC.Range("E" & wsHC.Rows.Count).End(xlUp)).Address
For Each cell In wsHC.Range("E14", wsHC.Range("E" & wsHC.Rows.Count).End(xlUp)).Cells
If cell.Text <> "" Then
oRS.Filter = ("RM TYP = '" & cell.Text & "'")
If oRS.RecordCount <> 0 Then
cell.Offset(0, 2).Value = oRS.Fields("STRUCT HT").Value
cell.Offset(0, 3).Value = oRS.Fields("CEILING HT").Value
End If
oRS.Filter = adFilterNone
End If
Next cell
End With
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
End Sub
Database: "C:\HC_MDB\HC_DB_ACC.mdb" Table = "info"
RM TYP DESCRIPTION STRUCT HT CEILING HT
E1 INSTRUCTIONAL 14 10
E2 SCIENCE / LAB 14 10
E3 OFFICE 14 9
E4 RECEPTION / WAITING 14 9
E5 STAFF 14 9
E6 CONFERENCE 14 9
E7 FOOD SERVICE 14 9
E8 UTILITY - SHOPS 14 9
E9 SERVICE - STORAGE 14 10
E10 "RESTROOMS ""General""" 14 9
E11 "RESTROOMS ""Private""" 14 8
E12 "COMMONS ""Single Entry""" 14 10
E13 "COMMONS ""Double Entry""" 14 11
E14 "COMMONS ""Zone Division""" 14 10
E15 SHAFT / PLENUM 14 14
E16 STAIR / ELV 14 14
E17 GYM
E18 ATHLETIC ROOMS
E19 ATHLETIC STORAGE
E20 LOCKER ROOMS
Thanks in advance
