excel 2013 VBA - Code works when Pressing F8 errors when auto

R

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
I have the following code which works fine if I move through it with F8. However, I get the following error if I just run the macro:

Error Number: 1004
Error Description: Select method of range class failed

Here is the section of code which calls two different functions

Code: 
Case 10
            intCELL = cell.Row
            strGL = "{610000,619000,619900,631000,632000,633000,634000,640000," _
                    & "650000,660000,661000,671000,672000,673000,679000,680000," _
                    & "685000,690000,721000,721100,721200,728000,729000,730000," _
                    & "760000}"
            strSUS300 = "{" & DYTB300(wsOB, intCELL, wbRECON) & "}"
            strSUS400 = "{" & DYTB400(wsOB, intCELL, wbRECON) & "}"
            intCOL = 4
            Do Until intCOL >= 13
                Set rng = ws.Cells(cell.Row, intCOL)
                Select Case intCOL
                    Case 4
                        rng.FormulaR1C1 = "=sum(SUM(SUMIFS('Trail Balance(s)'!R" _
                            & intROWtb & "C" & intCOLTBamt & ":R" & lngROWtb _
                            & "C" & intCOLTBamt & ",'Trail Balance(s)'!R" _
                            & intROWtb & "C" & intCOLTBgl & ":R" & lngROWtb _
                            & "C" & intCOLTBgl & "," & strGL _
                            & ",'Trail Balance(s)'!R" & intROWtb & "C" _
                            & intCOLTBsus & ":R" & lngROWtb & "C" & intCOLTBsus _
                            & "," & strSUS400 & "))-SUM(SUMIFS('Trail Balance(s)'!R" _
                            & intROWtb & "C" & intCOLTBamt & ":R" & lngROWtb _
                            & "C" & intCOLTBamt & ",'Trail Balance(s)'!R" _
                            & intROWtb & "C" & intCOLTBgl & ":R" & lngROWtb _
                            & "C" & intCOLTBgl & "," & strGL _
                            & ",'Trail Balance(s)'!R" & intROWtb & "C" _
                            & intCOLTBsus & ":R" & lngROWtb & "C" & intCOLTBsus _
                            & "," & strSUS300 & ")))"

                    Case 6
                        rng.FormulaR1C1 = "=sum(SUM(SUMIFS('OBIEE'!R" _
                            & intROWob & "C" & intCOLOBamt & ":R" & lngROWob _
                            & "C" & intCOLOBamt & ",'OBIEE'!R" _
                            & intROWob & "C" & intCOLOBgl & ":R" & lngROWob _
                            & "C" & intCOLOBgl & "," & strGL _
                            & ",'OBIEE'!R" & intROWob & "C" _
                            & intCOLOBsus & ":R" & lngROWob & "C" & intCOLOBsus _
                            & "," & strSUS400 & "))-SUM(SUMIFS('OBIEE'!R" _
                            & intROWob & "C" & intCOLOBamt & ":R" & lngROWob _
                            & "C" & intCOLOBamt & ",'OBIEE'!R" _
                            & intROWob & "C" & intCOLOBgl & ":R" & lngROWob _
                            & "C" & intCOLOBgl & "," & strGL _
                            & ",'OBIEE'!R" & intROWob & "C" _
                            & intCOLOBsus & ":R" & lngROWob & "C" & intCOLOBsus _
                            & "," & strSUS300 & ")))"
                    Case 8
                        rng.FormulaR1C1 = "=RC[-4]-RC[-2]"
                    Case 10
                        rng.Value = 0#
                        With rng.Interior
                            .ThemeColor = xlThemeColorAccent1
                            .TintAndShade = 0.599993896298105
                        End With
                    Case 12
                        rng.FormulaR1C1 = "=RC[-6]-RC[-2]"
                End Select
                intCOL = intCOL + 2
            Loop
        Case 11
            intCELL = cell.Row
            strGL = "{610000,619000,619900,631000,632000,633000,634000,640000," _
                    & "650000,660000,661000,671000,672000,673000,679000,680000," _
                    & "685000,690000,721000,721100,721200,728000,729000,730000," _
                    & "760000}"
            strSUS300 = "{" & DYTB300(wsOB, intCELL, wbRECON) & "}"
            intCOL = 4
            Do Until intCOL >= 13
                Set rng = ws.Cells(cell.Row, intCOL)
                Select Case intCOL
                    Case 4
                        rng.FormulaR1C1 = "=SUM(SUMIFS('Trail Balance(s)'!R" _
                            & intROWtb & "C" & intCOLTBamt & ":R" & lngROWtb _
                            & "C" & intCOLTBamt & ",'Trail Balance(s)'!R" _
                            & intROWtb & "C" & intCOLTBgl & ":R" & lngROWtb _
                            & "C" & intCOLTBgl & "," & strGL _
                            & ",'Trail Balance(s)'!R" & intROWtb & "C" _
                            & intCOLTBsus & ":R" & lngROWtb & "C" & intCOLTBsus _
                            & "," & strSUS300 & "))"
                    Case 6
                        rng.FormulaR1C1 = "=SUM(SUMIFS('OBIEE'!R" _
                            & intROWob & "C" & intCOLOBamt & ":R" & lngROWob _
                            & "C" & intCOLOBamt & ",'OBIEE'!R" _
                            & intROWob & "C" & intCOLOBgl & ":R" & lngROWob _
                            & "C" & intCOLOBgl & "," & strGL _
                            & ",'OBIEE'!R" & intROWob & "C" _
                            & intCOLOBsus & ":R" & lngROWob & "C" & intCOLOBsus _
                            & "," & strSUS300 & "))"
                    Case 8
                        rng.FormulaR1C1 = "=RC[-4]-RC[-2]"
                    Case 10
                        rng.Value = 0#
                        With rng.Interior
                            .ThemeColor = xlThemeColorAccent1
                            .TintAndShade = 0.599993896298105
                        End With
                    Case 12
                        rng.FormulaR1C1 = "=RC[-6]-RC[-2]"
                End Select
                intCOL = intCOL + 2
            Loop

they call (Case 10 calls both case 11 only calls the first one):

Code: 
Function DYTB300(wsOB As Worksheet, intCELL As Integer, wbRECON As Workbook)
Dim lngROW As Long, lngCOL As Long
Dim intROWst As Integer, intACCT As Integer, intGL As Integer, intSUS As Integer
Dim rngHEAD As Range, rngCOPY As Range, rng As Range
Dim strSUS As String
Dim wb As Workbook
Dim wsDY As Worksheet

Set wsDY = wbRECON.Worksheets.Add(after:=wbRECON.Worksheets(Worksheets.Count))
    With wsOB
        lngROW = LASTrow(wsOB)
        lngCOL = LASTCOL(wsOB)
        intROWst = wsOB.Cells(1, 1).End(xlDown).Row
        Set rngHEAD = wsOB.Range(wsOB.Cells(intROWst, 1), wsOB.Cells(intROWst, lngCOL))
        intACCT = rngHEAD.Find("SBS_CD").Column
        intGL = rngHEAD.Find("SGL_CD").Column
        intSUS = rngHEAD.Find("SUS_ID").Column
        Set rngCOPY = wsOB.Range(wsOB.Cells(intROWst, intACCT), wsOB.Cells(lngROW, intACCT))
        rngCOPY.Copy
        wsDY.Cells(1, 1).PasteSpecial xlPasteAll
        Set rngCOPY = wsOB.Range(wsOB.Cells(intROWst, intGL), wsOB.Cells(lngROW, intGL))
        rngCOPY.Copy
        wsDY.Cells(1, 2).PasteSpecial xlPasteAll
        Set rngCOPY = wsOB.Range(wsOB.Cells(intROWst, intSUS), wsOB.Cells(lngROW, intSUS))
        rngCOPY.Copy
        wsDY.Cells(1, 3).PasteSpecial xlPasteAll
    End With

    wsDY.Select
    With wsDY
        lngROW = LASTrow(wsDY)
        lngCOL = LASTCOL(wsDY)
        Set rng = wsDY.Range(wsDY.Cells(1, 1), wsDY.Cells(lngROW, lngCOL))
        appEXCEL.CutCopyMode = False
        rng.AutoFilter
        rng.AutoFilter Field:=2, Criteria1:=Array( _
        "610000", "619000", "619900", "631000", "632000", "633000", "634000", "640000", _
        "650000", "660000", "661000", "671000", "672000", "673000", "679000", "680000", _
        "685000", "690000", "721000", "721100", "721200", "728000", "729000", "730000", _
        "760000"), Operator:=xlFilterValues

        rng.SpecialCells(xlCellTypeVisible).Copy
        wsDY.Cells(1, 5).PasteSpecial xlPasteAll
        wsDY.AutoFilterMode = False
        wsDY.Columns("A:D").EntireColumn.Delete

        Set rngHEAD = wsDY.Range(wsDY.Cells(1, 1), wsDY.Cells(1, lngCOL))
        Set rngCOPY = wsDY.Range(wsDY.Cells(1, 2), wsDY.Cells(lngROW, lngCOL))
        intACCT = rngHEAD.Find("SBS_CD").Column
        intGL = rngHEAD.Find("SGL_CD").Column
        intSUS = rngHEAD.Find("SUS_ID").Column
        rngHEAD.AutoFilter Field:=1, Criteria1:="300"
        rngCOPY.SpecialCells(xlCellTypeVisible).Copy
        wsDY.Cells(1, 7).PasteSpecial xlPasteAll
        wsDY.AutoFilterMode = False

        wsDY.Columns("A:F").EntireColumn.Delete
        Set rng = wsDY.Range(wsDY.Cells(1, 1), wsDY.Cells(lngROW, 2))
        
        rng.Sort Key1:=wsDY.Range("A2:A" & lngROW), Order1:=xlAscending, _
        Key2:=wsDY.Range("B2:B" & lngROW), Order2:=xlAscending, Header:=xlYes
        
        rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
        lngROW = LASTrow(wsDY)
        Set rng = wsDY.Range(wsDY.Cells(2, 2), wsDY.Cells(lngROW, 2))
        strSUS = Combine(rng)
    End With
    wsDY.Delete
    DYTB300 = strSUS
End Function
Function DYTB400(wsOB As Worksheet, intCELL As Integer, wbRECON As Workbook)
Dim lngROW As Long, lngCOL As Long
Dim intROWst As Integer, intACCT As Integer, intGL As Integer, intSUS As Integer
Dim rngHEAD As Range, rngCOPY As Range, rng As Range
Dim strSUS As String
Dim wb As Workbook
Dim wsDY As Worksheet

Set wsDY = wbRECON.Worksheets.Add(after:=wbRECON.Worksheets(Worksheets.Count))
    With wsOB
        lngROW = LASTrow(wsOB)
        lngCOL = LASTCOL(wsOB)
        intROWst = wsOB.Cells(1, 1).End(xlDown).Row
        Set rngHEAD = wsOB.Range(wsOB.Cells(intROWst, 1), wsOB.Cells(intROWst, lngCOL))
        intACCT = rngHEAD.Find("SBS_CD").Column
        intGL = rngHEAD.Find("SGL_CD").Column
        intSUS = rngHEAD.Find("SUS_ID").Column
        Set rngCOPY = wsOB.Range(wsOB.Cells(intROWst, intACCT), wsOB.Cells(lngROW, intACCT))
        rngCOPY.Copy
        wsDY.Cells(1, 1).PasteSpecial xlPasteAll
        Set rngCOPY = wsOB.Range(wsOB.Cells(intROWst, intGL), wsOB.Cells(lngROW, intGL))
        rngCOPY.Copy
        wsDY.Cells(1, 2).PasteSpecial xlPasteAll
        Set rngCOPY = wsOB.Range(wsOB.Cells(intROWst, intSUS), wsOB.Cells(lngROW, intSUS))
        rngCOPY.Copy
        wsDY.Cells(1, 3).PasteSpecial xlPasteAll
    End With
    wsDY.Select
    With wsDY
        lngROW = LASTrow(wsDY)
        lngCOL = LASTCOL(wsDY)
        Set rng = wsDY.Range(wsDY.Cells(1, 1), wsDY.Cells(lngROW, lngCOL))
        appEXCEL.CutCopyMode = False
        rng.AutoFilter
        rng.AutoFilter Field:=2, Criteria1:=Array( _
        "610000", "619000", "619900", "631000", "632000", "633000", "634000", "640000", _
        "650000", "660000", "661000", "671000", "672000", "673000", "679000", "680000", _
        "685000", "690000", "721000", "721100", "721200", "728000", "729000", "730000", _
        "760000"), Operator:=xlFilterValues
        
        rng.SpecialCells(xlCellTypeVisible).Copy
        wsDY.Cells(1, 5).PasteSpecial xlPasteAll
        wsDY.AutoFilterMode = False
        wsDY.Columns("A:D").EntireColumn.Delete
        
        Set rngHEAD = wsDY.Range(wsDY.Cells(1, 1), wsDY.Cells(1, lngCOL))
        Set rngCOPY = wsDY.Range(wsDY.Cells(1, 2), wsDY.Cells(lngROW, lngCOL))
        intACCT = rngHEAD.Find("SBS_CD").Column
        intGL = rngHEAD.Find("SGL_CD").Column
        intSUS = rngHEAD.Find("SUS_ID").Column
        rngHEAD.AutoFilter Field:=1, Criteria1:="400"
        rngCOPY.SpecialCells(xlCellTypeVisible).Copy
        wsDY.Cells(1, 10).PasteSpecial xlPasteAll
        wsDY.AutoFilterMode = False
        
        wsDY.Columns("A:I").EntireColumn.Delete
        
        Set rng = wsDY.Range(wsDY.Cells(1, 1), wsDY.Cells(lngROW, 2))
        rng.Select
        
        rng.Sort Key1:=wsDY.Range("A2:A" & lngROW), Order1:=xlAscending, _
        Key2:=wsDY.Range("B2:B" & lngROW), Order2:=xlAscending, Header:=xlYes

        rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
        lngROW = LASTrow(wsDY)
        Set rng = wsDY.Range(wsDY.Cells(2, 2), wsDY.Cells(lngROW, 2))
        strSUS = Combine(rng)
    End With

    wsDY.Delete
    DYTB400 = strSUS
End Function

both above functions call the following:

Code: 
Function Combine(WorkRng As Range, Optional Sign As String = ";") As String
Dim rng As Range
Dim OutStr As String
For Each rng In WorkRng
    If rng.Text <> "," Then
        OutStr = OutStr & rng.Text & Sign
    End If

Next
Combine = Left(OutStr, Len(OutStr) - 1)
End Function

any idea why it breaks when running macro but works fine when I F8 through the code?

thanks in advance
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
You could have pointed out which line of code was highlighted when you encountered the error. The code is pretty dense to have to wade through, and I can only assume it's this line near the end of the second code block:

Code: 
rng.Select

Knowing this still isn't enough a priori to know what's wrong. But I'll share some experience.

When code runs fine while stepping through, but throws an error when running at full speed, and especially if you can then hit F5 to make it continue running, the cause is often a kind of timing issue. The prior commands have asked Excel to do something, and this might also cause Windows to get involved (redrawing the screen, creating windows for a newly inserted workbook, etc.). When the previous tasks aren't finished, the current step may not be ready to run. For instance, deleting some columns might not be completely finished in time for the range to be defined and selected.

I see this a lot with code that is creating and formatting new workbooks and worksheets, and code that accesses PowerPoint or Word.

You can often get around this using DoEvents:

Code: 
DoEvents
rng.Select

DoEvents makes VBA pause while background events are processed.
 
Upvote 0
Hi Jon,

Sorry about the big blocks of code. the reason it was done that way is that I added an error catcher and line numbering to the code since it worked as I tabbed through it with F8. However, I had not yet added those to these modules. SO the error capture was referencing the last line in the chain.

Thanks for the Do.events line. I will line and errcapture these procedures and add the do events when the code pauses to complete and action when I F8. Those pauses may very well be causing the error.

Rich
 
Upvote 0
Rich

As far as I see you don't need to select anything as all the ranges in the code appear to be properly set/qualified.
 
Upvote 0
Jon Peltier said:
You could have pointed out which line of code was highlighted when you encountered the error. The code is pretty dense to have to wade through, and I can only assume it's this line near the end of the second code block:

Code: 
rng.Select

Knowing this still isn't enough a priori to know what's wrong. But I'll share some experience.

When code runs fine while stepping through, but throws an error when running at full speed, and especially if you can then hit F5 to make it continue running, the cause is often a kind of timing issue. The prior commands have asked Excel to do something, and this might also cause Windows to get involved (redrawing the screen, creating windows for a newly inserted workbook, etc.). When the previous tasks aren't finished, the current step may not be ready to run. For instance, deleting some columns might not be completely finished in time for the range to be defined and selected.

I see this a lot with code that is creating and formatting new workbooks and worksheets, and code that accesses PowerPoint or Word.

You can often get around this using DoEvents:

Code: 
DoEvents
rng.Select

DoEvents makes VBA pause while background events are processed.
Click to expand...


doevents did the trick thanks for the help.
 
Upvote 0
You might also try not selecting the range. I missed this, but Norie suggested it, and I think it's worth removing.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
[VBA] File saving does not work/new version not uploaded
Replies
4
Views
727
NdNoviceHlp
NdNoviceHlp
R
  • Question Question
VBA - Code keeps crashing
Replies
2
Views
815
offthelip
O
R
  • Question Question
ACCESS VBA - Code won't run more than once when importing data from excel
2
Replies
10
Views
2K
Micron
M

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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