Here is one way:
Option Explicit
Option Base 1
Sub InvertTheData()
Dim DataArray(65000, 5) As Variant
Dim Fnd As Double
Dim X As Double
Dim Y As Double
Dim Z as double
Do While True
If Cells(X, 1).Value = Empty Then Exit Do
Y = 5
Do While True
If Cells(X, Y).Value = Empty Then Exit Do
Fnd = Fnd + 1
For Z = 1 To 4
DataArray(Fnd, Z) = Cells(X, Z)
Next
DataArray(Fnd, 5) = Cells(X, Y)
Y = Y + 1
Loop
X = X + 1
Loop
Windows("WhereToPutData.xls").Activate
Sheets("SheetToPutData").Select
Range("A65000").End(xlUp).Select 'this is a row with data, this row +1 is
empty!
X = ActiveCell.Row + 1
For Y = 1 To Fnd
For Z = 1 To 5
Cells(X, Z).Value = DataArray(Y, Z)
Next
Next
End Sub
Carrie_Loos - 30 May 2008 17:22 GMT
Thanks Mike -
I keep getting an error message on the 1st If statement "If Cells(X, 1).Value
= Empty Then" that states 'Application-defined or Object-defined error' ?
>Here is one way:
>Option Explicit
[quoted text clipped - 33 lines]
>Next
>End Sub
Mike H. - 30 May 2008 17:29 GMT
I forgot. You need to set x=1 before you start evaluating or you get that
message. Add this:
x=1
add it before the "Do While True" line.
> Thanks Mike -
>
[quoted text clipped - 38 lines]
> >Next
> >End Sub
Carrie_Loos - 30 May 2008 17:49 GMT
Thanks - It works well except in the "WhereToPutData" workbook/sheet it isn't
moving down a row and placing the serial number underneath each other, rather
it is overwriting the same cell/row . It seems that the code "X = ActiveCell.
Row + 1" should be taking care of it?
>I forgot. You need to set x=1 before you start evaluating or you get that
>message. Add this:
[quoted text clipped - 8 lines]
>> >Next
>> >End Sub
Mike H. - 30 May 2008 18:06 GMT
Between the bottom two Next lines, add a line:
x=x+1
Sorry again. I didn't test this myself.
> I forgot. You need to set x=1 before you start evaluating or you get that
> message. Add this:
[quoted text clipped - 45 lines]
> > >Next
> > >End Sub
Carrie_Loos - 30 May 2008 18:46 GMT
Are you kidding? No need to apologize, do you know how many painful hours you
saved me as well as teaching me code for a dynamic array macro? It is worth
it's weight in gold! Thank you for taking the time to help!
Carrie
>Between the bottom two Next lines, add a line:
>x=x+1
[quoted text clipped - 6 lines]
>> > >Next
>> > >End Sub