Excel freezes when I run this macro (portuguese)

A

annakarenfm

New Member
Joined
Mar 26, 2018
Messages
1
Hi,

I used to work with this macro however it stoped work. It is linked to a application (NewHotel) in order to retrieve sales revenue of 9 hotels. Can anyone help me with this error?
'------------------------------------------------------------------------------------------
'********************************** TODAY ************************************************
'------------------------------------------------------------------------------------------
Code: 
Sub NEWHOTEL_GetDay_Sales()
 
'Definição de Variaveis
Dim rsOraH As ADODB.Recordset    'History
Set cnOra = New ADODB.Connection
Dim NrDias, Counter As Integer
NrDias = Date - CDate("1-1-2015")
 
DateInicio = Date - NrDias
DiaColuna = 3
 
While Counter <= NrDias
 
CounterRPQ = 3
CounterRRS = 3
CounterRPL = 3
CounterROE = 3
CounterGRVI = 3
CounterRBV = 3
CounterGRSE = 3
CounterRMO = 3
CounterRMR = 3
 
 
DataIni = Format(DateInicio, "yyyymmdd")
 
 
'REAL PARQUE______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o RPQ
db_name = "NEWHOTEL"
UserName = "RMCRPQ"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'RPQ' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'RPQ'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'RPQ'", cnOra, adOpenForwardOnly
           
          
If Not rsOraH.EOF Then
 
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("RPQ_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("RPQ_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRPQ, 1).Value Then
            Worksheets("RPQ_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRPQ, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterRPQ = CounterRPQ + 1
        Else
            Worksheets("RPQ_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRPQ, DiaColuna).Value = 0
            CounterRPQ = CounterRPQ + 1
        End If
       
Wend
 
End If
rsOraH.Close
cnOra.Close
 
'REAL RESIDENCIA______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o RRS
db_name = "NEWHOTEL"
UserName = "RMCRRS"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'RRS' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'RRS'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'RRS'", cnOra, adOpenForwardOnly
           
If Not rsOraH.EOF Then
 
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("RRS_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("RRS_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRRS, 1).Value Then
            Worksheets("RRS_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRRS, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterRRS = CounterRRS + 1
        Else
            Worksheets("RRS_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRRS, DiaColuna).Value = 0
            CounterRRS = CounterRRS + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'REAL PALACIO______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o RPL
db_name = "NEWHOTEL"
UserName = "RMCRPL"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'RPL' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'RPL'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'RPL'", cnOra, adOpenForwardOnly
                       
If Not rsOraH.EOF Then
                       
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("RPL_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("RPL_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRPL, 1).Value Then
            Worksheets("RPL_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRPL, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterRPL = CounterRPL + 1
        Else
            Worksheets("RPL_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRPL, DiaColuna).Value = 0
            CounterRPL = CounterRPL + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'REAL OEIRAS______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o ROE
db_name = "NEWHOTEL"
UserName = "RMCRO"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'ROE' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'ROE'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'ROE'", cnOra, adOpenForwardOnly
 
If Not rsOraH.EOF Then
           
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("ROE_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("ROE_EXPORT_NEWHOTEL_BGOMES").Cells(CounterROE, 1).Value Then
            Worksheets("ROE_EXPORT_NEWHOTEL_BGOMES").Cells(CounterROE, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterROE = CounterROE + 1
        Else
            Worksheets("ROE_EXPORT_NEWHOTEL_BGOMES").Cells(CounterROE, DiaColuna).Value = 0
            CounterROE = CounterROE + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'GRANDE REAL VILLA ITALIA______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o GRVI
db_name = "NEWHOTEL"
UserName = "RMCGRVI"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'GRVI' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'GRVI'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'GRVI'", cnOra, adOpenForwardOnly
           
If Not rsOraH.EOF Then
           
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("GRVI_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("GRVI_EXPORT_NEWHOTEL_BGOMES").Cells(CounterGRVI, 1).Value Then
            Worksheets("GRVI_EXPORT_NEWHOTEL_BGOMES").Cells(CounterGRVI, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterGRVI = CounterGRVI + 1
        Else
            Worksheets("GRVI_EXPORT_NEWHOTEL_BGOMES").Cells(CounterGRVI, DiaColuna).Value = 0
            CounterGRVI = CounterGRVI + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'GRANDE REAL ST: EULALIA______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o GRSE
db_name = "NEWHOTEL"
UserName = "RMCGRSE"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'GRSE' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'GRSE'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'GRSE'", cnOra, adOpenForwardOnly
            
If Not rsOraH.EOF Then
           
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("GRSE_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("GRSE_EXPORT_NEWHOTEL_BGOMES").Cells(CounterGRSE, 1).Value Then
            Worksheets("GRSE_EXPORT_NEWHOTEL_BGOMES").Cells(CounterGRSE, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterGRSE = CounterGRSE + 1
        Else
            Worksheets("GRSE_EXPORT_NEWHOTEL_BGOMES").Cells(CounterGRSE, DiaColuna).Value = 0
            CounterGRSE = CounterGRSE + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'REAL BELLAVISTA______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o RBV
db_name = "NEWHOTEL"
UserName = "RMCRBL"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
 
rsOraH.Open " SELECT" & _
                " MOV.serv_codi," & _
                " SER.serv_desc," & _
                " 'RBV' as Hotel," & _
                " SUM (MOV.serv_codi) as Pax," & _
                " COUNT (MOV.serv_codi) as Lancamentos," & _
                " SUM(MOV.movi_vliq) as Total" & _
            " FROM vnht_movh MOV, tnht_serv SER" & _
            " WHERE" & _
            " SER.serv_codi = MOV.serv_codi" & _
            " AND (MOV.movi_datr >= TO_DATE('" & DataIni & "','yyyymmdd') AND MOV.movi_datr <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY MOV.serv_codi, SER.serv_desc, 'RBV'" & _
            " ORDER BY MOV.serv_codi, SER.serv_desc, 'RBV'", cnOra, adOpenForwardOnly
           
If Not rsOraH.EOF Then
           
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("RBV_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![serv_codi]) = Worksheets("RBV_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRBV, 1).Value Then
            Worksheets("RBV_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRBV, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterRBV = CounterRBV + 1
        Else
            Worksheets("RBV_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRBV, DiaColuna).Value = 0
            CounterRBV = CounterRBV + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'REAL MARINA HOTEL______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o RMOH
db_name = "NEWHOTEL"
UserName = "RMCRMH"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
           
rsOraH.Open " SELECT" & _
                " servico," & _
                " 'RMOH' as Hotel," & _
                " 0 as Pax," & _
                " 0 as Lancamentos," & _
                " SUM(valor) as Total" & _
            " FROM RMCRMH.VNHT_VENDAS_QUARTOS_PAX" & _
            " WHERE" & _
            " BLOCO = 'REVENUE' " & _
            " AND servico<>'XXX'" & _
            " AND TIPO_ALOJ NOT IN('T1','T1+1','T2','T2+1','T3')" & _
            " AND (data >= TO_DATE('" & DataIni & "','yyyymmdd') AND data <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY servico,'RMOH'" & _
            " ORDER BY servico,'RMOH'", cnOra, adOpenForwardOnly
           
           
If Not rsOraH.EOF Then
           
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("RMH_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![servico]) = Worksheets("RMH_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRMO, 1).Value Then
            Worksheets("RMH_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRMO, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterRMO = CounterRMO + 1
        Else
            Worksheets("RMH_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRMO, DiaColuna).Value = 0
            CounterRMO = CounterRMO + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
'REAL MARINA RESIDENCIA______________________________________________________________________________________
'Criação da ligação ODBC usando o modelo ADO para o RMOR
db_name = "NEWHOTEL"
UserName = "RMCRMH"
Password = "RMC"
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
Set rsOraH = New ADODB.Recordset
rsOraH.CursorLocation = adUseServer
 
           
rsOraH.Open " SELECT" & _
                " servico," & _
                " 'RMOR' as Hotel," & _
                " 0 as Pax," & _
                " 0 as Lancamentos," & _
                " SUM(valor) as Total" & _
            " FROM RMCRMH.VNHT_VENDAS_QUARTOS_PAX" & _
            " WHERE" & _
            " BLOCO = 'REVENUE' " & _
            " AND servico<>'XXX'" & _
            " AND TIPO_ALOJ IN('T1','T1+1','T2','T2+1','T3')" & _
            " AND (data >= TO_DATE('" & DataIni & "','yyyymmdd') AND data <= TO_DATE('" & DataIni & "','yyyymmdd'))" & _
            " GROUP BY servico,'RMOR'" & _
            " ORDER BY servico,'RMOR'", cnOra, adOpenForwardOnly
           
If Not rsOraH.EOF Then
           
rsOraH.MoveFirst
 
While Not rsOraH.EOF
    Worksheets("RMR_EXPORT_NEWHOTEL_BGOMES").Activate
        If Val(rsOraH![servico]) = Worksheets("RMR_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRMR, 1).Value Then
            Worksheets("RMR_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRMR, DiaColuna).Value = rsOraH![Total]
            rsOraH.MoveNext
            CounterRMR = CounterRMR + 1
        Else
            Worksheets("RMR_EXPORT_NEWHOTEL_BGOMES").Cells(CounterRMR, DiaColuna).Value = 0
            CounterRMR = CounterRMR + 1
        End If
       
Wend
End If
rsOraH.Close
cnOra.Close
 
DateInicio = DateInicio + 1
Counter = Counter + 1
DiaColuna = DiaColuna + 1
 
Wend
 
 
Set rsOraH = Nothing
Set cnOra = Nothing
End Sub
 
Last edited by a moderator:

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
now when you run code , the screen will not update because the code is running too fast.
So is your macro locked, or just running too fast?

put in break points in various places to see.
But, if you are cycling thru records and putting them onto the sheet, then do it all at once instead of 1 by 1....

ActiveCell.CopyFromRecordset rst
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Macro Error for connecting with database
Replies
3
Views
2K
Norie
Norie
P
  • Question Question
Database Output
Replies
0
Views
515
Perch1224
P

Forum statistics

Threads
1,223,897
Messages
6,175,271
Members
452,628
Latest member
dd2

Share this page

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