I have a file that is stored in a column type fashion, when I transpose the
the worksheet so it will be more database friendly, rows, I end up with
multiple serial numbers in columns to the right rather than down. Example

This is what I have now:

Part Nbr Part Desc Inv Loc Date Serial Nbr
12345 XYZ New York 03/12/08 543 709 2889 2803 555
4321 ZZZ New York 03/12/08 123 321 456 654


This is what I want:
Part Nbr Part Desc Inv Loc Date Serial Nbr
12345 XYZ New York 03/12/08 543
12345 XYZ New York 03/12/08 709
12345 XYZ New York 03/12/08 2889
12345 XYZ New York 03/12/08 2803
12345 XYZ New York 03/12/08 555
12345 XYZ New York 03/12/08 2884
4321 ZZZ New York 03/12/08 123
4321 ZZZ New York 03/12/08 321
4321 ZZZ New York 03/12/08 456
4321 ZZZ New York 03/12/08 654
4321 ZZZ New York 03/12/08 789
4321 ZZZ New York 03/12/08 987

I have been fooling with some If statements with ActiveCell locations but I
keep getting stuck and can't work through it. Any suggestions? My approach is
too simple I think. I was going to insert a row paste the serial number in
the blank row and then data fill the rest in....... Need Help Please

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200805/1

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

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' ?



Mike H. wrote:
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200805/1

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.

"Carrie_Loos via OfficeKB.com" wrote:

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' ?



Mike H. wrote:
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200805/1

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?

Mike H. wrote:
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200805/1

Between the bottom two Next lines, add a line:
x=x+1

Sorry again. I didn't test this myself.

"Mike H." wrote:

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.

"Carrie_Loos via OfficeKB.com" wrote:

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' ?



Mike H. wrote:
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200805/1

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

Mike H. wrote:
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

--
Message posted via http://www.officekb.com