Error 1004 When using Range Cell

lalaluye

New Member
Joined
May 20, 2015
Messages
14
Hello,

I am facing run time errors 1004 with this piece of code. It is strange because this code worked in another module, but when I placed this in a userform sheet, it doesn't work.

VB:



Dim FileName As String
Dim SummarySheet As Worksheet
Dim WorkBk As Workbook
Dim FolderPath As String
Dim LastRow As Long
Dim LastCol As Long
Dim NRow As Long
Dim NCol As Long
Dim SourceRange As Range
Dim DestRange As Range


' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Set Worksheet Name
ActiveSheet.Name = "BTS1 DL_HARQ"

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*BTS1_PHYMAC(DL_HARQ).csv*")

' Initialize column to 1
NCol = 1


' Loop until Dir returns an empty string.
Do While FileName <> ""

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)

' Set the cell in row 1 to be the file name.
SummarySheet.Cells(1, NCol) = FileName

'Find the last row to be copied
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

'Find the last row to be copied
LastCol = ActiveSheet.Cells(13, Columns.Count).End(xlToLeft).Column

' Set the source range to be K14 to last row
' Modify this range for your workbooks.
' It can span multiple rows.
' Set SourceRange = WorkBk.Worksheets(1).Range("K14:K" & Lastrow)

Dim rFind As Range
Dim ColCount As Long
Dim FindRow As Long
Dim FindCol As Long

For ColCount = 1 To LastCol
With Range(Cells(1, ColCount), Cells(LastRow, ColCount))
Set rFind = .Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
If Not rFind Is Nothing Then
FindRow = rFind.Row
FindCol = rFind.Column
End If
End With
Next ColCount

Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol))

' Set the destination range to start at row 2 and
' be the same size as the source range.
Set DestRange = SummarySheet.Cells(NRow + 1, NCol)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value

' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
FileName = Dir()

' Increase NCol to copy the next file on the next column
NCol = NCol + 1
Loop

End Sub



I found the issue occurring on this line when using breakpoints

VB:
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol))


I have researched and tried everything such as

VB:
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol)).Resize(LastRow)


VB:
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol)).Resize(LastRow, LastCol)


VB:
With WorkBk.Worksheets(1)
.Range(.Cells(FindRow + 2, FindCol), .Cells(FindRow + 2, FindCol))
End With


And none seemed to work. Again this code worked before on another module. I don't know why it's not working when I put in under the command button sub for userform.

Please help
 
Thanks for your help. I did as you told me and added the msgbox. As you said it displayed 0's and an error box.
It should be identical because I directly copied and pasted the text to the code. The spaces and spelling. I did it a few times to make sure.

I also modified my code to:

Code:
        Dim rFind As Range
        Dim ColCount As Long
        Dim FindRow As Long
        Dim FindCol As Long
        
        For ColCount = 1 To LastCol
            With Range(WorkBk.Worksheets(1).Cells(1, ColCount), WorkBk.Worksheets(1).Cells(LastRow, ColCount))
                Set rFind = .Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFind Is Nothing Then
                    FindRow = rFind.Row
                    FindCol = rFind.Column
                End If
            End With
        Next ColCount
        
        MsgBox "FindRow =  " & FindRow & "  Findcol = " & FindCol
        MsgBox rFind.Address
        
        Set SourceRange = WorkBk.Worksheets(1).Range(WorkBk.Worksheets(1).Cells(FindRow + 2, FindCol), WorkBk.Worksheets(1).Cells(LastRow, FindCol))

And I get a Error 1004 on the line

Code:
            With Range(WorkBk.Worksheets(1).Cells(1, ColCount), WorkBk.Worksheets(1).Cells(LastRow, ColCount))

Did I write something wrong in the code?
 
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Thanks for your help. I did as you told me and added the msgbox. As you said it displayed 0's and an error box.
It should be identical because I directly copied and pasted the text to the code. The spaces and spelling. I did it a few times to make sure.

I also modified my code to:

Code:
        Dim rFind As Range
        Dim ColCount As Long
        Dim FindRow As Long
        Dim FindCol As Long
        
        For ColCount = 1 To LastCol
            With Range(WorkBk.Worksheets(1).Cells(1, ColCount), WorkBk.Worksheets(1).Cells(LastRow, ColCount))
                Set rFind = .Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFind Is Nothing Then
                    FindRow = rFind.Row
                    FindCol = rFind.Column
                End If
            End With
        Next ColCount
        
        MsgBox "FindRow =  " & FindRow & "  Findcol = " & FindCol
        MsgBox rFind.Address
        
        Set SourceRange = WorkBk.Worksheets(1).Range(WorkBk.Worksheets(1).Cells(FindRow + 2, FindCol), WorkBk.Worksheets(1).Cells(LastRow, FindCol))

And I get a Error 1004 on the line

Code:
            With Range(WorkBk.Worksheets(1).Cells(1, ColCount), WorkBk.Worksheets(1).Cells(LastRow, ColCount))

Did I write something wrong in the code?
 
Upvote 0
Did I write something wrong in the code?

Code:
WorkBk.Worksheets(1).Range(WorkBk.Worksheets(1).Cells(1, ColCount), WorkBk.Worksheets(1).Cells(LastRow, ColCount))
or
Code:
With WorkBk.Worksheets(1)
.Range(.Cells(1, ColCount), .Cells(LastRow, ColCount))
End With

Does the code below work any better?

Code:
    Dim x As Range
    'middle part of your code
    For ColCount = 1 To LastCol
        With WorkBk.Worksheets(1)
            Set x = .Range(.Cells(1, ColCount), .Cells(LastRow, ColCount))
            Set rFind = x.Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFind Is Nothing Then
                FindRow = rFind.Row
                FindCol = rFind.Column
            End If
        End With
    Next ColCount

    MsgBox "FindRow =  " & FindRow & "  Findcol = " & FindCol
 
Last edited:
Upvote 0
Do you mean like this?

Code:
        For ColCount = 1 To LastCol
            With WorkBk.Worksheets(1)
                With Range(Cells(1, ColCount), Cells(LastRow, ColCount))
                    Set rFind = .Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
                    If Not rFind Is Nothing Then
                        FindRow = rFind.Row
                        FindCol = rFind.Column
                    End If
                End With
            End With
        Next ColCount

Directly replacing that line with your lines gave me a syntax error.

I still got the same 1004 error on

Code:
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol))

and modified the code to:

Code:
        With WorkBk.Worksheets(1)
            Set SourceRange = .Range(.Cells(FindRow + 2, FindCol), .Cells(LastRow, FindCol))
        End With

Also tried

Code:
Set SourceRange = WorkBk.Worksheets(1).Range(WorkBk.Worksheets(1).Cells(FindRow + 2, FindCol), WorkBk.Worksheets(1).Cells(LastRow, FindCol))

Got the same error still though. Not sure if the modified code is valid.
 
Upvote 0
Please stop playing around with
Code:
        With WorkBk.Worksheets(1)
            Set SourceRange = .Range(.Cells(FindRow + 2, FindCol), .Cells(LastRow, FindCol))
        End With

It is not where your issue is.


Try (untested)
Code:
Sub ssss()
    Dim FileName As String
    Dim SummarySheet As Worksheet
    Dim WorkBk As Workbook
    Dim FolderPath As String
    Dim LastRow As Long
    Dim LastCol As Long
    Dim NRow As Long
    Dim NCol As Long
    Dim SourceRange As Range
    Dim DestRange As Range


    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    ' Set Worksheet Name
    ActiveSheet.Name = "BTS1 DL_HARQ"

    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "*BTS1_PHYMAC(DL_HARQ).csv*")

    ' Initialize column to 1
    NCol = 1


    ' Loop until Dir returns an empty string.
    Do While FileName <> ""

        ' NRow keeps track of where to insert new rows in the destination workbook.
        NRow = 1

        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & FileName)

        ' Set the cell in row 1 to be the file name.
        SummarySheet.Cells(1, NCol) = FileName

        'Find the last row to be copied
        LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

        'Find the last row to be copied
        LastCol = ActiveSheet.Cells(13, Columns.Count).End(xlToLeft).Column

        ' Set the source range to be K14 to last row
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        ' Set SourceRange = WorkBk.Worksheets(1).Range("K14:K" & Lastrow)

        Dim rFind As Range
        Dim ColCount As Long
        Dim FindRow As Long
        Dim FindCol As Long, x As Range

        For ColCount = 1 To LastCol
            With WorkBk.Worksheets(1)
                Set x = .Range(.Cells(1, ColCount), .Cells(LastRow, ColCount))
                Set rFind = x.Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFind Is Nothing Then
                    FindRow = rFind.Row
                    FindCol = rFind.Column
                End If
            End With
        Next ColCount

        MsgBox "LastRow =  " & LastRow & "  LastCol = " & LastCol
        MsgBox "FindRow =  " & FindRow & "  Findcol = " & FindCol

        With WorkBk.Worksheets(1)
            Set SourceRange = .Range(.Cells(FindRow + 2, FindCol), .Cells(LastRow, FindCol))
        End With


        ' Set the destination range to start at row 2 and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Cells(NRow + 1, NCol)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
                                         SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False

        ' Use Dir to get the next file name.
        FileName = Dir()

        ' Increase NCol to copy the next file on the next column
        NCol = NCol + 1
    Loop

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,114
Members
452,302
Latest member
TaMere

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