From: sebastico on

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

"Dave Peterson" wrote:

> 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
>
>
>
>
> On 05/18/2010 14:24, sebastico wrote:
> > 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
> .
>
From: sebastico on

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



"Rick Rothstein" wrote:

> Can you explain, in words, what this code is supposed to be doing?
>
> --
> Rick (MVP - Excel)
>
>
>
> "sebastico" <sebastico(a)discussions.microsoft.com> wrote in message
> news:685A6A7A-CCEA-447F-BBC5-E89E9645801C(a)microsoft.com...
> > 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
>
> .
>
From: Dave Peterson on
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.




On 05/18/2010 17:16, sebastico wrote:
>
> 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
>
> "Dave Peterson" wrote:
>
>> 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
>>
>>
>>
>>
>> On 05/18/2010 14:24, sebastico wrote:
>>> 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
>> .
>>
From: sebastico on

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
"Dave Peterson" wrote:

> 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.
>
>
>
>
> On 05/18/2010 17:16, sebastico wrote:
> >
> > 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
> >
> > "Dave Peterson" wrote:
> >
> >> 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
> >>
> >>
> >>
> >>
> >> On 05/18/2010 14:24, sebastico wrote:
> >>> 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
> >> .
> >>
> .
>