PDA

View Full Version : Error 1004 when selecting a range of cells



isrisian
01-18-2011, 09:57 AM
I've been working on a piece of test code that opens another spread sheet, copies all the information in a particular column, then pastes that data back in the original spread sheet. Currently I’m also trying to add in the ability for the code to print “NA” in all the spaces where the work sheet being copied from is blank, such that if further worksheets are copied, the data all lines up in the composite sheet. I accomplish this by storing the length of the previous copied row in a variable OldRange, and then selecting the blank row out to this range, but it is in that line that I get an Error 1004 Application defined or object defined error. I’ve checked the line for the causes of this error that I’ve found on other forums but I have so far, been unsuccessful. Any help in correcting this problem would be greatly appreciated.

PS: the hi-lighted line is where the error occurs

Option Explicit

Sub Copy_Cells()
Dim FlNm As String
Dim wb As Workbook
Dim LR As Long
Dim cl As Integer
Dim name As String
Dim col As String
Dim colP As String
Dim ref As Integer
Dim iReply As Integer
Dim refN As String
Dim OldRange As Integer

OldRange = 0

begin:

'choose file
FlNm = Application.GetOpenFilename
If FlNm = "False" Or FlNm = "" Then Exit Sub

'open file
Set wb = Workbooks.Open(FlNm)
'
For ref = 1 To 4
'set columns to find
Select Case ref
Case 1
refN = "Apples"
Case 2
refN = "Cars"
Case 3
refN = "Sheep"
Case 4
refN = "Sand People"
End Select
'select column to copy to
For cl = 1 To 30

'Get name
name = ActiveSheet.Cells(1, cl)
If refN = name Then
col = ConvertToLetter(cl)
colP = ConvertToLetter(ref)
'copy data, add to current workbook at next empty cell in column A
With wb.Sheets("Sheet1")
If IsEmpty(ActiveSheet.Cells(2, col)) Then
ThisWorkbook.Sheets("Sheet1").Range(col & 2, col & OldRange).End(xlUp).Select
Selection = "NA"
Else
OldRange = Range(col & .Rows.Count).End(xlUp).Row
MsgBox OldRange
.Range(col & 2, .Range(col & .Rows.Count).End(xlUp)).Copy _
ThisWorkbook.Sheets("Sheet1").Range(colP & Rows.Count).End(xlUp).Offset(1)
End If
Exit For
End With
End If
Next cl

Next ref

'close opened file
wb.Close False

iReply = MsgBox(Prompt:="Would you like to add another file?", _
Buttons:=vbYesNoCancel)



If iReply = vbYes Then

GoTo begin

ElseIf iReply = vbNo Then

Exit Sub
Else 'They cancelled (VbCancel)

Exit Sub

End If

End Sub

Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function

Artik
01-18-2011, 02:44 PM
Probably when you run the macro is not active Sheet1. When activated, eg Sheet2 you can not select a cell in Sheet1. First you need to activate Sheet1, and then select a cell in the worksheet.

In general, there is no need to select a cell in the worksheet. Replace these lines of code:ThisWorkbook.Sheets("Sheet1").Range(col & 2, col & OldRange).End(xlUp).Select
Selection = "NA"on:ThisWorkbook.Sheets("Sheet1").Range(col & 2, col & OldRange).End(xlUp).Value = "NA"
BTW. To convert I use little other function:Function ConvertToLetter(iCol As Long) As String

With ThisWorkbook.Worksheets(1).Cells(iCol)
ConvertToLetter = Replace(.Cells(1).Address(0, 0), .Row, "")
End With

End Function
Artik

isrisian
01-18-2011, 02:52 PM
Artik,

I tried what you suggested and the error went away, however it replaced cell C1 with NA even though the values of col and OldRange right before that line executed were C and 12 respectively.