MoveLast ERROR

Dear all,

I have a problem with this code (since 1 month ago). There are problems with the MoveLast and MoveFirst function and I have been looking for it about 4 weeks ago and no solution, so please if you can help me :)

Code:

---

Sub ImportarModelos()
    Dim strSource As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim consulta As String
Dim archivoAbrir As Excel.Workbook
    Dim RUTAExcel As String
    Dim strRespuesta As String
Dim posicionhoja As Integer
    Dim rangocopiar As Range
    Dim rangopegar As Range
Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim m As Long
Dim cantcarroc As Long
    Dim matrizcarroc(150) As String
    Dim ETYPE As String
    Dim modelo As String
    Static cantmodelos As String
    Dim planta As String
Dim numMES1 As Integer
    Dim numMES2 As Integer
    Dim numMES3 As Integer
    Dim numMES4 As Integer
    Dim numMES5 As Integer
    Dim numMES6 As Integer
    Dim numMES7 As Integer
    Dim numMES8 As Integer
    Dim numMES9 As Integer
    Dim numMES10 As Integer
    Dim numMES11 As Integer
    Dim numMES12 As Integer
Dim StartTime As Double
    Dim MinutesElapsed As String
strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
                    vbQuestion + vbYesNo, "Importación de Modelos")
If strRespuesta = vbNo Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
'Colocar ACT y FC en la Plantilla
    Call Etiquetar_FC_ACT
'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
    RUTAExcel = RutaTool.Range("D2") & "" & RutaTool.Range("C2")
    Set archivoAbrir = Workbooks.Open(RUTAExcel)
'Ruta bbdd
    With archivoAbrir
        strSource = ActiveSheet.Range("D6").Value & "" & ActiveSheet.Range("C6").Value
        .Close
    End With
    Set dbs = DBEngine.OpenDatabase(strSource, False, False)
sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
    dbs.Execute sFechaBotonModelos
'Aviso de ejecucion importar datos
    Application.StatusBar = "Importando MODELOS desde Base de Datos"
marca = indice.Range("B10")
If marca = "TODAS" Then
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
        & "FROM ModelosBD " _
        & "WHERE (((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
        & "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
        & "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
Else
        consulta = "SELECT DISTINCT ModelosBD.E_CS " _
        & "FROM ModelosBD " _
        & "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
End If
Set rst = dbs.OpenRecordset(consulta)
    rst.MoveLast          <---------- error
    rst.MoveFirst          <---------- error
cantcarroc = rst.RecordCount
    For i = 1 To cantcarroc
        matrizcarroc(i) = rst.Fields(0)
        rst.MoveNext
    Next i
'** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
canthojas = Worksheets.Count
If canthojas > 14 Then
        For m = canthojas To 15 Step -1  'PARA CADA HOJA
            Sheets(m).Delete
        Next
    End If 'canthojas >14
    Sheets(3).Visible = True 'NuevaPlantilla
For m = 1 To cantcarroc
        Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
    Next m
    Sheets(3).Visible = False
For i = 1 To cantcarroc

---

check if there is at least a record fetched by the recordset:

Code:

---

Set rst = dbs.OpenRecordset(consulta)
If not (rst.BOF and rst.EOF) Then
.MoveLast
.MoveFirst
'continue with the code
Else
'the recordset is empty
Msgbox "No record was found!"
End If
rst.Close
set rst = Nothing

---

I get the message: No record was found!

I dont know too much about VBA, but I put your code like this:

Code:

---

Sub ImportarModelos()
    Dim strSource As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim consulta As String
Dim archivoAbrir As Excel.Workbook
    Dim RUTAExcel As String
    Dim strRespuesta As String
Dim posicionhoja As Integer
    Dim rangocopiar As Range
    Dim rangopegar As Range
Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim m As Long
Dim cantcarroc As Long
    Dim matrizcarroc(150) As String
    Dim ETYPE As String
    Dim modelo As String
    Static cantmodelos As String
    Dim planta As String
Dim numMES1 As Integer
    Dim numMES2 As Integer
    Dim numMES3 As Integer
    Dim numMES4 As Integer
    Dim numMES5 As Integer
    Dim numMES6 As Integer
    Dim numMES7 As Integer
    Dim numMES8 As Integer
    Dim numMES9 As Integer
    Dim numMES10 As Integer
    Dim numMES11 As Integer
    Dim numMES12 As Integer
Dim StartTime As Double
    Dim MinutesElapsed As String
strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
                    vbQuestion + vbYesNo, "Importación de Modelos")
If strRespuesta = vbNo Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
'Colocar ACT y FC en la Plantilla
    Call Etiquetar_FC_ACT
'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
    RUTAExcel = RutaTool.Range("D2") & "" & RutaTool.Range("C2")
    Set archivoAbrir = Workbooks.Open(RUTAExcel)
'Ruta bbdd
    With archivoAbrir
        strSource = ActiveSheet.Range("D6").Value & "" & ActiveSheet.Range("C6").Value
        .Close
    End With
    Set dbs = DBEngine.OpenDatabase(strSource, False, False)
sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
    dbs.Execute sFechaBotonModelos
'Aviso de ejecucion importar datos
    Application.StatusBar = "Importando MODELOS desde Base de Datos"
marca = indice.Range("B10")
If marca = "TODAS" Then
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
        & "FROM ModelosBD " _
        & "WHERE (((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
        & "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
        & "OR (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
Else
        consulta = "SELECT DISTINCT ModelosBD.E_CS " _
        & "FROM ModelosBD " _
        & "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In (SELECT Modelcode FROM [InvoicesAG]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_NSCStock]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [SOYModel_DealerStock]) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_CC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM WholesaleVO_RAC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasCC) " _
        & "Or (ModelosBD.modelcode) in (SELECT Modelcode FROM MatriculasRAC) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [WholesaleTOTAL]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [IncomingORDERS]) " _
        & "Or (ModelosBD.Modelcode) In (SELECT Modelcode FROM [RetailTOTAL])))"
End If
Set rst = dbs.OpenRecordset(consulta)
    If Not (rst.BOF And rst.EOF) Then
    rst.MoveLast
    rst.MoveFirst
    Else
'the recordset is empty
MsgBox "No record was found!"
End If
rst.Close
Set rst = Nothing
cantcarroc = rst.RecordCount
    For i = 1 To cantcarroc
        matrizcarroc(i) = rst.Fields(0)
        rst.MoveNext
    Next i
'** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
canthojas = Worksheets.Count
If canthojas > 14 Then
        For m = canthojas To 15 Step -1  'PARA CADA HOJA
            Sheets(m).Delete
        Next
    End If 'canthojas >14
    Sheets(3).Visible = True 'NuevaPlantilla
For m = 1 To cantcarroc
        Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
    Next m
    Sheets(3).Visible = False
For i = 1 To cantcarroc

---

if there is No Record, what will you do?
i think you need to Stop and Exit the Sub.

Code:

---

Sub ImportarModelos()
Dim strSource As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim consulta As String
Dim archivoAbrir As Excel.Workbook
Dim RUTAExcel As String
Dim strRespuesta As String
Dim posicionhoja As Integer
Dim rangocopiar As Range
Dim rangopegar As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim cantcarroc As Long
Dim matrizcarroc(150) As String
Dim ETYPE As String
Dim modelo As String
Static cantmodelos As String
Dim planta As String
Dim numMES1 As Integer
Dim numMES2 As Integer
Dim numMES3 As Integer
Dim numMES4 As Integer
Dim numMES5 As Integer
Dim numMES6 As Integer
Dim numMES7 As Integer
Dim numMES8 As Integer
Dim numMES9 As Integer
Dim numMES10 As Integer
Dim numMES11 As Integer
Dim numMES12 As Integer
Dim StartTime As Double
Dim MinutesElapsed As String
strRespuesta = MsgBox("La importación de Modelos eliminará todos los datos anteriores. ¿Desea continuar?", _
vbQuestion + vbYesNo, "Importación de Modelos")
If strRespuesta = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Colocar ACT y FC en la Plantilla
Call Etiquetar_FC_ACT
'Ruta Excel con rutas almacenadas (Excel formulario cargar ficheros)
RUTAExcel = RutaTool.Range("D2") & "" & RutaTool.Range("C2")
Set archivoAbrir = Workbooks.Open(RUTAExcel)
'Ruta bbdd
With archivoAbrir
strSource = ActiveSheet.Range("D6").Value & "" & ActiveSheet.Range("C6").Value
.Close
End With
Set dbs = DBEngine.OpenDatabase(strSource, False, False)
sFechaBotonModelos = "UPDATE Fechas_Modelos SET Fecha_BotonModelos= Now()"
dbs.Execute sFechaBotonModelos
'Aviso de ejecucion importar datos
Application.StatusBar = "Importando MODELOS desde Base de Datos"
marca = indice.Range("B10")
If marca = "TODAS" Then
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Modelcode) In " _
& "(SELECT Modelcode FROM [InvoicesAG] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_NSCStock] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_DealerStock] UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_CC UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_RAC UNION ALL " _
& "SELECT Modelcode FROM MatriculasCC UNION ALL " _
& "SELECT Modelcode FROM MatriculasRAC UNION ALL " _
& "SELECT Modelcode FROM [WholesaleTOTAL] UNION ALL " _
& "SELECT Modelcode FROM [IncomingORDERS] UNION ALL " _
& "SELECT Modelcode FROM [RetailTOTAL])))"
Else
consulta = "SELECT DISTINCT ModelosBD.E_CS " _
& "FROM ModelosBD " _
& "WHERE (((ModelosBD.Brand)='" & marca & "') AND ((ModelosBD.Modelcode) In " _
& "(SELECT Modelcode FROM [InvoicesAG] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_NSCStock] UNION ALL " _
& "SELECT Modelcode FROM [SOYModel_DealerStock] UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_CC UNION ALL " _
& "SELECT Modelcode FROM WholesaleVO_RAC UNION ALL " _
& "SELECT Modelcode FROM MatriculasCC UNION ALL " _
& "SELECT Modelcode FROM MatriculasRAC UNION ALL " _
& "SELECT Modelcode FROM [WholesaleTOTAL] UNION ALL " _
& "SELECT Modelcode FROM [IncomingORDERS] UNION ALL " _
& "SELECT Modelcode FROM [RetailTOTAL])))"
End If
Set rst = dbs.OpenRecordset(consulta)
If (rst.BOF And rst.EOF) Then
    rst.Close
    Set rst = Nothing
    'the recordset is empty
    MsgBox "No record was found!"
    Exit Sub
Else
    rst.MoveLast
    rst.MoveFirst
    cantcarroc = rst.RecordCount
    For i = 1 To cantcarroc
        matrizcarroc(i) = rst.Fields(0)
        rst.MoveNext
    Next i
    '** para modelos, elimina todas las hojas y crea nueva por cada carrocería (para WH,RT e IO no elimina hojas)
    canthojas = Worksheets.Count
    If canthojas > 14 Then
    For m = canthojas To 15 Step -1 'PARA CADA HOJA
    Sheets(m).Delete
    Next
    End If 'canthojas >14
    Sheets(3).Visible = True 'NuevaPlantilla
    For m = 1 To cantcarroc
    Sheets(3).Copy after:=Sheets(14) 'copia la hoja Plantilla (oculta)
    Next m
    Sheets(3).Visible = False
    For i = 1 To cantcarroc
End If

---

Did i put your code in the correct order? Only happened this error this month, i have been working witch that code since 2 years ago and all worked good.

What do you think i have to do?

So i think the error in the code is before the movelast function

Hello, thank you for your reply and sorry for not being able to explain the error. The macro is extracting data from current months in order to predict future months. The error message I get is the following: "An error '3021' has occurred at runtime: there is no active record" When it has been working correctly for months and no one has touched the code.

You need to look at your data. It's not a code error per se, it's that nothing is matching your criteria so you don't get any records back.

Hello,


The data is correct, what's more, this process is done every month, and I have tried to do it again last month (which previously worked correctly) and now it doesn't work. I am afraid it is due to an update in the Office, but I am not able to find the error or the solution.

The fact is you are not getting any records returned from your query. Without your files, we can't even determine which of the queries is running, let alone why it isn't returning anything, so I'm afraid the debugging will have to be at your end.