Run-time error 1004

S

sebastico

Hello
I have this code taht when I run displays Run-timeerror 1004:
Application-defined or object-defined error.

Could you suggest me how to fix it?

Thanks in advance

Sub Copy_transpose()
Dim Row As Integer, Cols As Byte, nRow As Integer
Application.ScreenUpdating = False
nRow = 1

With Worksheets("Sheet1")
For Row = 1 To 668
Cols = Application.CountA(.Range("a" & Row).EntireRow) - 1
Worksheets("Sheet1").Range("a" & nRow).Resize(Cols).Value = .Range("a" &
Row).Value
Worksheets("Sheet1").Range("b" & nRow).Resize(Cols).Value =
Application.Transpose(.Range("b" & Row).Resize(, Cols).Value)
nRow = Worksheets("Sheet2").Range("a65536").End(xlUp).Row + 3
Next
End With
End Sub
 
B

Barb Reinhardt

Several suggestions:

1. Add the following at the beginning


Dim myWS as Excel.Worksheet

Set myWS = Worksheets("Sheet1")

Anywhere you have Worksheets("Sheet1"), put myWS

I think your resize piece is wrong. You need both a row and column entry
and both must be 1 or greater.
 
B

Barb Reinhardt

Lastly, I think I'd replace

"a65536" with "a" & myws.rows.count

the 65536 is applicable for Excel 2003, but not 2007.
 
D

Dave Peterson

First, I wouldn't use Row as a variable name. I wouldn't use "As Integer" or
"as Byte" either.

And since you're within a "With/End With" block, you can drop some of those
Worksheets("Sheet1") references.

Wait! Wait!

Those references are probably typos. You want the info to go to Sheet2!

And depending on your data, your code could be having trouble with the
..resize(cols) expression.

If there's 1 entry or 0 entries in that row, then it would cause a 1004 error.

But that's a guess, since you didn't say what line caused the error.

I have no idea if this does what you want/expect, but it did compile and run for me:

Option Explicit
Sub Copy_transpose()
Dim myRow As Long
Dim Cols As Long
Dim nRow As Long
Application.ScreenUpdating = False
nRow = 1

With Worksheets("Sheet1")
For myRow = 1 To 668
Cols = Application.CountA(.Range("a" & myRow).EntireRow) - 1

If Cols < 1 Then
'do nothing
Else
Worksheets("Sheet2").Rows(nRow).Resize(Cols).Value _
= .Range("a" & myRow).Value

Worksheets("Sheet2").Range("b" & nRow).Resize(Cols).Value _
= Application.Transpose(.Range("b" & myRow) _
.Resize(, Cols).Value)

nRow = Worksheets("Sheet2").Range("a65536").End(xlUp).Row + 3
End If

Next myRow
End With
End Sub
 
S

sebastico

Dave
Your code works but not as I Need.
U have a table like this:

A1 has AA, PP, BB, CC
A2 has CC, DD, RR, NN, XX,
A3 has RR
An

I need the code doing this:
A1 AA
A1 PP
A1 BB
A1 CC
A2 CC
A2 DD
A2 RR
A2 NN
A2 XX
A3 RR

Sorry I can not explain more clearly but English is not my mother tongue
 
S

sebastico

Rick
I have a xls table with:
665 rows
Each row has at least one record, for example
ColumnA ColumnB ColumnC Column D
A1 BB CC
A2 WW EE
A3 AA
A4 RR BB QQ

Code must do
A1 BB
A1 CC
A2 WW
A2 EE
A3 AA
A4 RR
A4 RR
A4 BB
A4 QQ
etc to row 665

Thanks in advance
 
D

Dave Peterson

Your notes to Rick were much better than your notes to me, but that's ok!.

And you had too many RR in the output in that description, right?

Option Explicit
Sub Copy_transpose()

Dim iRow As Long
Dim oRow As Long
Dim iWks As Worksheet
Dim oWks As Worksheet
Dim HowManyToCopy As Long

Application.ScreenUpdating = False

Set iWks = Worksheets("Sheet1")
Set oWks = Worksheets("sheet2")

oWks.Cells.Clear 'start with a fresh worksheet???

oRow = 1
With iWks
'just to the last used row -- not always 668 or 665
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
HowManyToCopy = Application.CountA(.Rows(iRow)) - 1

If HowManyToCopy = 0 Then
'do nothing
Else
oWks.Rows(oRow).Resize(HowManyToCopy, 1).Value _
= .Cells(iRow, "A").Value

oWks.Cells(oRow, "B").Resize(HowManyToCopy).Value _
= Application.Transpose(.Cells(iRow, "B") _
.Resize(1, HowManyToCopy).Value)

oRow = oRow + HowManyToCopy
End If

Next iRow
End With

Application.ScreenUpdating = True

End Sub

I changed some of your variables. I like iRow for inputRow; oRow for OutputRow,
iwks and owks for input and output worksheet.

And I liked howmanytocopy better than cols.
 
S

sebastico

Dave

Sorry for my text to you.
I going to test your code and I let you know as soon as possible

Well, I fixed my error as follow"

Option Explicit

Sub Copy_transpose()
Dim Row As Integer, Cols As Byte, nRow As Integer
Application.ScreenUpdating = False
nRow = 1

With Worksheets("Sheet1")
For Row = 1 To 632
Cols = Application.CountA(.Range("a" & Row).EntireRow) - 1
Worksheets("Sheet2").Range("a" & nRow).Resize(Cols).Value = .Range("a" &
Row).Value

Worksheets("Sheet2").Range("b" & nRow).Resize(Cols).Value =
Application.Transpose(.Range("b" & Row).Resize(, Cols).Value)

nRow = Worksheets("Sheet2").Range("a65536").End(xlUp).Row + 3
Next
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top