VBA error 1004

J

Jarks

New Member
Joined
Jun 6, 2014
Messages
9
Hello

I wrote a macro that moves through worksheets performing the same tasks in each. The macro works fine when there are a few sheets to go through, but when I start adding more worksheets, I get error 1004. I've started also getting a message box that comes up but its completely black so i cant even see what the message is. I thought about the possibility of running out of memory, but I don't get close to maxing out my computers available memory, and i tried to unlock all the cells in the worksheets too.

Does anyone know how I can get my code to run through more sheets without messing up?

Thanks for being so smart,
Jarks
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
I'm really new to this, but here is my lengthy code below.

There is no particular place in the code that I'm getting the error. It seems to stop at a different point through the code every time.

Pretty much the macro opens up some sheets, then formats the sheets, creates some pivot tables, then links the data to the summary sheet.

Code: 
Sub RAMM()'
'First Step
    'Add WSC data files
Dim directory As String, filename As String, sheet As Worksheet, total As Integer
Dim ProjNo As String, Wrkbk As String, csPath As String, userinput As String




Application.ScreenUpdating = False
Application.ScreenUpdating = False


    OldName = ThisWorkbook.FullName
    ProjNo = InputBox(prompt:="Please enter the project number.", _
          Title:="Enter Project Number", Default:="#######")
    
    If ProjNo = "#######" Or ProjNo = vbNullString Then
        MsgBox "You did not enter the Project Number, re-run Macro"
        Exit Sub
    Else
    
    csPath = InputBox(prompt:="Enter your project folder where you would like to save this file.", _
        Title:="Enter Project Folder", Default:="C:\")
    If csPath = "C:\" Or csPath = vbNullString Then
        MsgBox "You did not enter the project file folder location"
        Exit Sub
    Else
    
    Wrkbk = ProjNo & "_MeanMonthly_RegionalAnalysis.xlsm"
    ActiveWorkbook.SaveAs filename:=csPath & "\" & Wrkbk, FileFormat:=52
    
    userinput = MsgBox("Would you like to add WSC data? (If no, you may add data manually)", vbYesNo, "Data type")
    
    If userinput = vbNo Then
        Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = "User Input Data"
        Range("A2").Select
        ActiveCell = "ID"
        Range("B2").Select
        ActiveCell = "PARAM"
        Range("C2").Select
        ActiveCell = "Date"
        Range("D2").Select
        ActiveCell = "Flow"
        Range("E2").Value = "SYM"
        Exit Sub
    Else
    directory = InputBox(prompt:="Please enter the path directory to the folder that contains your monthly data.", _
          Title:="Enter file path", Default:="C:\")


        If directory = "C:\" Or directory = vbNullString Then
            MsgBox "You did not enter a file path. Manually insert data, or re-run Macro."
            
        Else
filename = Dir(directory & "\" & "*.csv")


    Do While filename <> ""
    
    Workbooks.Open (directory & "\" & filename)
    
            total = Workbooks(Wrkbk).Worksheets.count
            Workbooks(filename).ActiveSheet.Copy _
            After:=Workbooks(Wrkbk).Sheets(total)
        
    Workbooks(filename).Close
    filename = Dir()
    


    Loop


    End If
        End If
    End If
    End If
    
'Second Step
    'Pivot tables
    
Dim ws As Worksheet, CondForm As Integer
    CondForm = InputBox(prompt:="What is the minimum number of data acceptable for a specific month (default is 15 days)", Title:="Conditional Formatting settings", Default:="15")


For Each ws In ActiveWorkbook.Worksheets
' Exclude certain sheets
        If ws.Name <> "MetaData" And ws.Name <> "Summary" And ws.Name <> "Macro Instructions" Then
    With ws
    
    'ActiveSheet
    ws.Name = "Macro"
    ws.Select


Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete


'add 0 data for each month to fill pivot table months from 1-12
Rows("2:13").Insert shift:=xlDown
Dim mo As Integer, ro As Integer
mo = 1
ro = 2
For ro = 2 To 13
    Cells(ro, 1).Value = Range("A14")
    Cells(ro, 3).Value = mo & "/1/2050"
    Cells(ro, 4).Value = ""
    mo = mo + 1
Next ro


    


'Create required data fields
    Columns("D:F").Select
    Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Year"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Month"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Value day"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=YEAR(RC[-1])"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
    Range("D2:E2").Select
    Range("E2").Activate
    Selection.NumberFormat = "General"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[1]<>"""",RC[1]*24*60*60,"""")"
    Selection.NumberFormat = "General"
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R2C1:R50000C1)"
    Dim count As Integer
    count = Range("A1").Value
    Dim i As Integer
    i = count + 1


    Range("D2:F2").Select
    Selection.AutoFill Destination:=Range("D2:F" & i)
    
    Range("A1").Select
    ActiveCell.Value = "ID"
    
    'CREATE PIVOT TABLE DATA SET FROM WS
Dim WSD As Worksheet


Dim PT1Cache As PivotCache


Dim PT1 As PivotTable


Dim PRange As Range


Dim FinalRow As Long


Dim FinalCol As Long


Dim StrRange As String




Set WSD = Worksheets("Macro")






'Name active worksheet as "PivotTable"


'ActiveSheet.Name = "Macro"


Worksheets("Macro").Select


 


' Define input area and set up a Pivot Cache


FinalRow = WSD.Cells(Application.Rows.count, 1).End(xlUp).Row


FinalCol = WSD.Cells(1, Application.Columns.count).End(xlToLeft).Column


Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)


StrRange = PRange.Address






Set PT1Cache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=StrRange)




 


' CREATE COUNT PIVOT TABLE


Set PT1 = PT1Cache.CreatePivotTable(TableDestination:=WSD.Cells(7, FinalCol + 2), TableName:="PivotTable98")




' Turn off updating while building the table
PT1.ManualUpdate = True


 


' Set up the row fields


PT1.AddFields RowFields:="Year", ColumnFields:="Month"


 


' Set up the data fields
Dim field1 As String
field1 = Range("G1")


With PT1.PivotFields(field1)


    .Orientation = xlDataField


    .Function = xlCount


    .Position = 1


End With




With ActiveSheet.PivotTables("PivotTable98").PivotFields("PARAM")
    .Orientation = xlPageField
    .Position = 1
End With


 


' Calc the pivot table


PT1.ManualUpdate = False


PT1.ManualUpdate = True
 
' END OF FIRST PIVOT TABLE CREATE




' Average PIVOT TABLE START
    
Dim PT2 As PivotTable


Dim PT2Cache As PivotCache


Set PT2Cache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=StrRange)


Set PT2 = PT2Cache.CreatePivotTable(TableDestination:=WSD.Cells(7, FinalCol + 18), TableName:="PivotTable99")




' Turn off updating while building the table
PT2.ManualUpdate = True




' Set up the row fields


PT2.AddFields RowFields:="Year", ColumnFields:="Month"


 


' Set up the data fields


With PT2.PivotFields(field1)


    .Orientation = xlDataField


    .Function = xlAverage


    .Position = 1


End With






With ActiveSheet.PivotTables("PivotTable99").PivotFields("PARAM")
    .Orientation = xlPageField
    .Position = 1
End With


 


' Calc the pivot table


PT2.ManualUpdate = False


PT2.ManualUpdate = True
 
' END OF AVERAGE PIVOT TABLE CREATE
    
' SUM value day PIVOT TABLE START
    
Dim PT3 As PivotTable


Dim PT3Cache As PivotCache


Set PT3Cache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=StrRange)


Set PT3 = PT3Cache.CreatePivotTable(TableDestination:=WSD.Cells(7, FinalCol + 34), TableName:="PivotTable100")




' Turn off updating while building the table
PT3.ManualUpdate = True




' Set up the row fields


PT3.AddFields RowFields:="Year"


 


' Set up the data fields


With PT3.PivotFields("Value day")


    .Orientation = xlDataField


    .Function = xlSum


    .Position = 1


End With




With ActiveSheet.PivotTables("PivotTable100").PivotFields("PARAM")
    .Orientation = xlPageField
    .Position = 1
End With


With ActiveSheet.PivotTables("PivotTable100").PivotFields("Month")
    .Orientation = xlPageField
    .Position = 1
End With


' Calc the pivot table


PT3.ManualUpdate = False


PT3.ManualUpdate = True
 
' END OF SUM PIVOT TABLE CREATE
    
' SUM value PIVOT TABLE START
    
Dim PT4 As PivotTable


Dim PT4Cache As PivotCache


Set PT4Cache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=StrRange)


Set PT4 = PT4Cache.CreatePivotTable(TableDestination:=WSD.Cells(7, FinalCol + 37), TableName:="PivotTable101")




' Turn off updating while building the table
PT4.ManualUpdate = True




' Set up the row fields


PT4.AddFields RowFields:="Year"


 


' Set up the data fields


With PT4.PivotFields(field1)


    .Orientation = xlDataField


    .Function = xlSum


    .Position = 1


End With




With ActiveSheet.PivotTables("PivotTable101").PivotFields("PARAM")
    .Orientation = xlPageField
    .Position = 1
End With


With ActiveSheet.PivotTables("PivotTable101").PivotFields("Month")
    .Orientation = xlPageField
    .Position = 1
End With


' Calc the pivot table


PT4.ManualUpdate = False


PT4.ManualUpdate = True
 
' END OF SUM PIVOT TABLE CREATE






' Set up sheet for summary fill
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[6]C:R[199]C)"
    Range("Z2").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+6"
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "=""AA""&R[1]C[-1]"
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "=""AB""&R[1]C[-2]"
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "=""AC""&R[1]C[-3]"
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "=""AD""&R[1]C[-4]"
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "=""AE""&R[1]C[-5]"
    Range("AF1").Select
    ActiveCell.FormulaR1C1 = "=""AF""&R[1]C[-6]"
    Range("AG1").Select
    ActiveCell.FormulaR1C1 = "=""AG""&R[1]C[-7]"
    Range("AH1").Select
    ActiveCell.FormulaR1C1 = "=""AH""&R[1]C[-8]"
    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "=""AI""&R[1]C[-9]"
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "=""AJ""&R[1]C[-10]"
    Range("AK1").Select
    ActiveCell.FormulaR1C1 = "=""AK""&R[1]C[-11]"
    Range("AL1").Select
    ActiveCell.FormulaR1C1 = "=""AL""&R[1]C[-12]"
    
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AC2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AG2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AH2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AK2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    Range("AL2").Select
    ActiveCell.FormulaR1C1 = "=INDIRECT(R[-1]C)"
    
    Range("AP1").Select
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[200]C)"
    Range("AP2").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C + 8"
    Range("AQ1").Select
    ActiveCell.FormulaR1C1 = "=""AQ9:AQ""&R[1]C[-1]"
    Range("AQ2").Select
    ActiveCell.FormulaR1C1 = "=Average(INDIRECT(R[-1]C))"
    
' Conditional Formatting
    Dim YrRow As Integer, j As Integer, YrCol As Integer
    
    j = Range("Z2").Value
    For YrRow = 9 To j - 1
        For YrCol = 11 To 23
        Cells(YrRow, YrCol).Select
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
        Formula1:=CondForm
        Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions(1).ScopeType = xlSelectionScope
        
        Next YrCol
    Next YrRow
    
'Fill summary sheet
    Sheets("Summary").Select
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R3C1"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C27"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C28"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C29"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C30"
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C31"
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C32"
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C33"
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C34"
    Range("M4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C35"
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C36"
    Range("O4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C37"
    Range("P4").Select
    ActiveCell.FormulaR1C1 = "=Macro!R2C38"
    Range("Q4").Select
    ActiveCell.Formula = "=Macro!AQ2/(Summary!D4*1000^2)*1000"
    Range("A3").Offset(1).EntireRow.Insert
        
'Rename Macro to station ID
    Worksheets("Macro").Select
    ws.Name = [A2]
    
    'lock cells
    ActiveSheet.Unprotect
    Selection.Locked = False
    Range("A1:ZZ50000").Select
    Selection.Locked = False
    Range("Z1:AZ2").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect Password:="Golder", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowUsingPivotTables:=True
        
       End With
    End If
    Next ws
    Application.ScreenUpdating = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Error Number: 1004
Replies
5
Views
124
Tablecloth98
T
Noid67
  • Question Question
Run-time 1004 for this With statement
Replies
2
Views
149
Peter_SSs
Peter_SSs
S
  • Solved
Run-time error '1004'
Replies
3
Views
534
Domenic
D
S
  • Solved
Error 1004 - Application defined or object defined error for pvFld.PivotFilters.Add2 xlSpecificDate, , strFilter
Replies
7
Views
288
Alex Blakenburg
A
6StringJazzer
  • Question Question
Constantly getting "Out of memory" messages when VBA window is open
Replies
7
Views
864
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,222,229
Messages
6,164,738
Members
451,911
Latest member
HMF009

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