Need a little help please! I am getting runtime error 3001 at oRS.filter = ("RM TYP = '" & cell.Text & "'")
Private Sub CommandButton5_ Click()
Application.Scr eenUpdating = False
Application.Cal culation = xlCalculationMa nual
Dim oRS As New ADODB.Recordset
Dim oCN As New ADODB.Connectio n
With oCN
.Provider = "Microsoft.jet. oledb.4.0"
.CursorLocation = adUseClient
.Open "C:\HC_MDB\HC_D B_ACC.mdb"
End With
With oRS
.LockType = adLockOptimisti c
.CursorType = adOpenDynamic
.ActiveConnecti on = oCN
.Open "Select * from INFO"
Set wsHC = ThisWorkbook.Wo rksheets("RS")
MsgBox wsHC.Range("E14 ", wsHC.Range("E" & wsHC.Rows.Count ).End(xlUp)).Ad dress
For Each cell In wsHC.Range("E14 ", wsHC.Range("E" & wsHC.Rows.Count ).End(xlUp)).Ce lls
If cell.Text <> "" Then
oRS.Filter = ("RM TYP = '" & cell.Text & "'")
If oRS.RecordCount <> 0 Then
cell.Offset(0, 2).Value = oRS.Fields("STR UCT HT").Value
cell.Offset(0, 3).Value = oRS.Fields("CEI LING HT").Value
End If
oRS.Filter = adFilterNone
End If
Next cell
End With
Application.Cal culation = xlCalculationAu tomatic
Application.Cal culate
Application.Scr eenUpdating = True
End Sub
Database: "C:\HC_MDB\HC_D B_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
Private Sub CommandButton5_ Click()
Application.Scr eenUpdating = False
Application.Cal culation = xlCalculationMa nual
Dim oRS As New ADODB.Recordset
Dim oCN As New ADODB.Connectio n
With oCN
.Provider = "Microsoft.jet. oledb.4.0"
.CursorLocation = adUseClient
.Open "C:\HC_MDB\HC_D B_ACC.mdb"
End With
With oRS
.LockType = adLockOptimisti c
.CursorType = adOpenDynamic
.ActiveConnecti on = oCN
.Open "Select * from INFO"
Set wsHC = ThisWorkbook.Wo rksheets("RS")
MsgBox wsHC.Range("E14 ", wsHC.Range("E" & wsHC.Rows.Count ).End(xlUp)).Ad dress
For Each cell In wsHC.Range("E14 ", wsHC.Range("E" & wsHC.Rows.Count ).End(xlUp)).Ce lls
If cell.Text <> "" Then
oRS.Filter = ("RM TYP = '" & cell.Text & "'")
If oRS.RecordCount <> 0 Then
cell.Offset(0, 2).Value = oRS.Fields("STR UCT HT").Value
cell.Offset(0, 3).Value = oRS.Fields("CEI LING HT").Value
End If
oRS.Filter = adFilterNone
End If
Next cell
End With
Application.Cal culation = xlCalculationAu tomatic
Application.Cal culate
Application.Scr eenUpdating = True
End Sub
Database: "C:\HC_MDB\HC_D B_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
Comment