Subscript Out of range VBA Error

[trinidad2011]

Hi all,
If it is possible, i would like to know what the 'Subscript out of range error means' when trying to compile a VBA code?
I changed the code that i pasted below from what i found on the internet, according to my needs.

Does anyone know what this means? When i hit the debug button it highlights this line:

​

Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet report is built into


Here is my code
Sub Consolidate()

'Summary: Prompt user to open folder
'Open file, delete unwanted data, filter latitudes
'Longitudes to fit South Australian region

Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet

'Setup
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now

Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet report is built into

With wsMaster
If MsgBox("Clear the o data first?", vbYesNo) = vbYes Then
.Cells.Clear
NR = 1
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
End If

'Path and filename
'Prompting user to choose the required folder

MsgBox "Please select a folder with files to consolidate"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
fPath = .SelectedItems(1) & "\"
Exit Do
Else
If MsgBox("No folder chosen, do you wish to exit Macro?", _
vbYesNo) = vbYes Then Exit Sub
End If
End With
Loop

fPathDone = fPath & "Imported\" 'remember final \ in this string
On Error Resume Next
MkDir fPathDone 'creates the completed folder if missing
On Error GoTo 0
fName = Dir(fPath & "*.csv*") 'listing of desired files


'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file

'This is the section to customize, replace with your own action code as needed

Columns("F:I").Select
Selection.ClearContents
Columns("A:E").Select
Selection.AutoFilter
Columns("C:C").Select 'Filter Latitude
ActiveSheet.Range("$A$1:$E$31001").AutoFilter Field:=3, Criteria1:= _
">=-37.9382", Operator:=xlAnd, Criteria2:="<=-32.004"
Columns("D:D").Select 'Filter Longitude
ActiveSheet.Range("$A$1:$E$31001").AutoFilter Field:=4, Criteria1:= _
">=136.7754", Operator:=xlAnd, Criteria2:="<=141.0698"
Cells.Select
Selection.Copy
Workbooks.Add

wbData.Close False 'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
fName = Dir 'ready next filename
End If
Loop
End With

ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
End Sub
I will be delighted if someone can find the error or kindly explain what the error means

 

[Norie]

First - sorry for the double post.

I've got a mouse which is 'alive' and sometimes decides to press delete/backspace, either that or I inadvertently hit one of the buttons on the side.

I'm sure it's the mouse.

Anyway, wsSrc is just another variable - it's shorthand for source worksheet.

It's a reference to the worksheet in the opened workbook that has the data.

That's it, not totally essential but doesn't do any harm and it can help when writing code.

By the way, did the filtering part work?

 

[trinidad2011]

Yes the filtering works very well.
However, it copies and pastes the column titles all the time, so for each file, which there are 170 files in total, it copies the titles. How do i get rid of this, and only get it to copy the titles once?
the titles on the original are in columns A1:E1

I have tried fixing it, but with no luck.
Do you happen to have any ideas?
Regards.

 

[trinidad2011]

i forgot to attach my current code.

Sub Consolidate()
'Summary: Prompt user to open folder
'Open file, delete unwanted data, filter latitudes
'Longitudes to fit South Australian region
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
Dim wsSrc As Worksheet
    'Setup
Application.ScreenUpdating = False    'speed up macro execution
Application.EnableEvents = False    'turn off other macros for now
Application.DisplayAlerts = False    'turn off system messages for now
 
Set wsMaster = ThisWorkbook.Sheets("Master")    'sheet report is built into
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        wsMaster.Cells.Clear
        NR = 1
    Else
        NR = wsMaster.Range("A" & wsMaster.Rows.Count).End(xlUp).Row + 1    ' gets next availablerow on the 'Master' Worksheet
    End If
 
    'Path and filename
    'Prompting user to choose the required folder
    MsgBox "Please select a folder with files to consolidate"
    Do
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then
                fPath = .SelectedItems(1) & "\"
                Exit Do
            Else
                If MsgBox("No folder chosen, do you wish to exit Macro?", _
                          vbYesNo) = vbYes Then Exit Sub
            End If
        End With
    Loop
 
    fPathDone = fPath & "Imported\"    'remember final \ in this string
    
    On Error Resume Next
    MkDir fPathDone    'creates the completed folder if missing
    On Error GoTo 0
    
    fName = Dir(fPath & "*.csv*")    'listing of desired files
    'Import a sheet from found files
    Do While Len(fName) > 0
    
        If fName <> ThisWorkbook.Name Then    'don't reopen this file accidentally
 
            Set wbData = Workbooks.Open(fPath & fName)    'Open file
 
            Set wsSrc = wbData.Worksheets(1) ' assume only one worksheet in CSV file
            'This is the section to customize, replace with your own action code as needed
            wsSrc.Columns("F:I").ClearContents
            wsSrc.Range("A1:E1").Select
            Selection.Copy
            Range("A1").Select
            wsMaster.Paste
          
            With wsSrc
 
                .Columns("A:E").AutoFilter
                'Filter Latitude
                .Range("$A$1:$E$31001").AutoFilter Field:=3, Criteria1:= _
                                                   ">=-37.9382", Operator:=xlAnd, Criteria2:="<=-32.004"
                'Filter Longitude
                .Range("$A$1:$E$31001").AutoFilter Field:=4, Criteria1:= _
                                                              ">=136.7754", Operator:=xlAnd, Criteria2:="<=141.0698"
 
                .Range("A:E").Copy wsMaster.Range("A" & NR)
                
            End With
            
            wbData.Close False    'close file
 
            'Next row
            NR = wsMaster.Range("A" & wsMaster.Rows.Count).End(xlUp).Row + 1
            Name fPath & fName As fPathDone & fName    'move file to IMPORTED folder
            fName = Dir    'ready next filename
        End If
    Loop
 
    wsMaster.Columns.AutoFit
    
    Application.DisplayAlerts = True    'turn system alerts back on
    Application.EnableEvents = True    'turn other macros back on
    Application.ScreenUpdating = True    'refreshes the screen
    
End Sub

the only thing that i have added is

            wsSrc.Range("A1:E1").Select
            Selection.Copy
            Range("A1").Select
            wsMaster.Paste

which is found straight after

wsSrc.Columns("F:I").ClearContents

any kind suggestions as to why my addition does not work?

 

[trinidad2011]

Sorry for the third post....
I have run into trouble
after running through 7 or 8 from the folder, which has a total of about 200 excel workbooks, the following message appears

RUN time error 1004
The information cannot be pasted becasue the copy area and the paste area are not the same size and shape. try one of the following:
     Click a single cell and then paste
     Select a rectangle that is the same size and shape and then paste

Does this mean select a cell within the code?

 

[Norie]

Why did you make the change you made?

That might be what's causing the problem.

I'll post a bit of code to remove the header but it's probably best to sort out the error first.

 

[trinidad2011]

I had the added bit commented out...so it is not doing anything.
i have tried playing with the ranges, but no luck

 

[Norie]

So are what error are you getting now?

Do you know how many rows of data you will be importing?

I just wonder if you've reached the limit of rows on a worksheet.

Could that be possible?

PS To get rid of the headers all you should need is the highlighted code below

As you see it goes immediately after the code to copy the data into the master worksheet.

    .Range("A:E").Copy wsMaster.Range("A" & NR)    
 
    wsMaster.Rows(NR).Delete

 

[trinidad2011]

Hi!

The code stops running, yet the master sheet has only around 7000 cells filled out. The total in a worksheet is around 1 048 576, so the program hasnt reached the limit of cells.

The error that i am getting reads this way exactly

Run time error 1004
The information can not be pasted because the the copy area and the paste area are not thesame size and shape. Try one of the following:
Click a single cell and then paste
Select a rectangle thats the same size and shape and then paste

Do you think we should add a section in the code that selects the left most cell and then copies into the master worksheet?

 

[Norie]

You shouldn't need to select anything.

The destination for the copy in the code is a single cell on the 'master' worksheet.

Are there any merged cells in that worksheet?

 

[trinidad2011]

No there arent any merged cells in the Master worksheet.