I have a matrix of data that lists part numbers in row [1] and serial numbers
in column [A] as shown in Example 1. In the example below (Example 1), the
range beginning in cell [B2] and ending in cell [H6], is the number of days
from that serial number's manufacturing date that a part was replaced; i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another matrix to
summarize the data as displayed in Example 2. Where per serial number, the
parts that have a "0" are eliminated, and I'm left with only the parts that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F] [G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528 0
528
[3] 23B 0 497 157 0 497 0
497
[4] 34C 465 430 0 0 0 0
0
[5] 45D 0 378 0 398 0 0
0
[6] 56E 0 373 0 0 373 0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

Morton
This macro will do what you want. I assumed your data starts in Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The code
copies your table from the active sheet to the New Sheet and then does what
you want to the table in the active sheet. Post back if you need more. HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and serial
numbers
in column [A] as shown in Example 1. In the example below (Example 1),
the
range beginning in cell [B2] and ending in cell [H6], is the number of
days
from that serial number's manufacturing date that a part was replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another matrix to
summarize the data as displayed in Example 2. Where per serial number,
the
parts that have a "0" are eliminated, and I'm left with only the parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F] [G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497 0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0 373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

Hi Otto,
Thanks for your help. Unfortunately, I am getting a €œCompile Error: Syntax
Error€� and it is highlighting the code €œShift:=xlToLeft€�. Ill await your
reply.


"Otto Moehrbach" wrote:

Morton
This macro will do what you want. I assumed your data starts in Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The code
copies your table from the active sheet to the New Sheet and then does what
you want to the table in the active sheet. Post back if you need more. HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and serial
numbers
in column [A] as shown in Example 1. In the example below (Example 1),
the
range beginning in cell [B2] and ending in cell [H6], is the number of
days
from that serial number's manufacturing date that a part was replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another matrix to
summarize the data as displayed in Example 2. Where per serial number,
the
parts that have a "0" are eliminated, and I'm left with only the parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F] [G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497 0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0 373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

.

Morton
Unfortunately, posting code often results in line wrapping and VBA is
very intolerant of line wrapping. Below I have placed the first word of
each line of the code to help you in eliminating line wrapping.
Sub
Dim
Dim
Range
Sheets
Set
Set
For
rColA
rHeaders
Next
Set
For
For
If
rColA(c)
End If
Next d
Next c
End Sub
The "Shift:=xlToLeft" belongs after the word "Delete" above it with a space
between them. HTH Otto
"Morton Detwyler" wrote in
message ...
Hi Otto,
Thanks for your help. Unfortunately, I am getting a €œCompile Error:
Syntax
Error€� and it is highlighting the code €œShift:=xlToLeft€�. Ill await your
reply.


"Otto Moehrbach" wrote:

Morton
This macro will do what you want. I assumed your data starts in
Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The code
copies your table from the active sheet to the New Sheet and then does
what
you want to the table in the active sheet. Post back if you need more.
HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and serial
numbers
in column [A] as shown in Example 1. In the example below (Example 1),
the
range beginning in cell [B2] and ending in cell [H6], is the number of
days
from that serial number's manufacturing date that a part was replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another matrix
to
summarize the data as displayed in Example 2. Where per serial number,
the
parts that have a "0" are eliminated, and I'm left with only the parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F]
[G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497
0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0 373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

.

Otto,
Your macro worked perfectly! One last question, if my actual dataset began
in cell A1 and extended to cell AE1, and contained 1,619 rows, what parts of
your macro would I change? Again, thank you so much - this has really helped
me out!

"Otto Moehrbach" wrote:

Morton
Unfortunately, posting code often results in line wrapping and VBA is
very intolerant of line wrapping. Below I have placed the first word of
each line of the code to help you in eliminating line wrapping.
Sub
Dim
Dim
Range
Sheets
Set
Set
For
rColA
rHeaders
Next
Set
For
For
If
rColA(c)
End If
Next d
Next c
End Sub
The "Shift:=xlToLeft" belongs after the word "Delete" above it with a space
between them. HTH Otto
"Morton Detwyler" wrote in
message ...
Hi Otto,
Thanks for your help. Unfortunately, I am getting a €œCompile Error:
Syntax
Error€� and it is highlighting the code €œShift:=xlToLeft€�. Ill await your
reply.


"Otto Moehrbach" wrote:

Morton
This macro will do what you want. I assumed your data starts in
Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The code
copies your table from the active sheet to the New Sheet and then does
what
you want to the table in the active sheet. Post back if you need more.
HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and serial
numbers
in column [A] as shown in Example 1. In the example below (Example 1),
the
range beginning in cell [B2] and ending in cell [H6], is the number of
days
from that serial number's manufacturing date that a part was replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another matrix
to
summarize the data as displayed in Example 2. Where per serial number,
the
parts that have a "0" are eliminated, and I'm left with only the parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F]
[G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497
0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0 373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

.

.

Hi Otto,
I replied to your last post this morning, but do not see it - sorry if this
is a duplicate of that....

You macro worked perfectly - thank you for your guidance! I did have one
last question. My actual dataset begins in cell A1 and extends through cell
AE1, and contains 1,619 total rows, ending at cell address AE1619. How would
I change your macro to perform this function on my actual data? Again, thank
you very much for your time, assistance, and expertise.

Morton

"Otto Moehrbach" wrote:

Morton
Unfortunately, posting code often results in line wrapping and VBA is
very intolerant of line wrapping. Below I have placed the first word of
each line of the code to help you in eliminating line wrapping.
Sub
Dim
Dim
Range
Sheets
Set
Set
For
rColA
rHeaders
Next
Set
For
For
If
rColA(c)
End If
Next d
Next c
End Sub
The "Shift:=xlToLeft" belongs after the word "Delete" above it with a space
between them. HTH Otto
"Morton Detwyler" wrote in
message ...
Hi Otto,
Thanks for your help. Unfortunately, I am getting a €œCompile Error:
Syntax
Error€� and it is highlighting the code €œShift:=xlToLeft€�. Ill await your
reply.


"Otto Moehrbach" wrote:

Morton
This macro will do what you want. I assumed your data starts in
Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The code
copies your table from the active sheet to the New Sheet and then does
what
you want to the table in the active sheet. Post back if you need more.
HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and serial
numbers
in column [A] as shown in Example 1. In the example below (Example 1),
the
range beginning in cell [B2] and ending in cell [H6], is the number of
days
from that serial number's manufacturing date that a part was replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another matrix
to
summarize the data as displayed in Example 2. Where per serial number,
the
parts that have a "0" are eliminated, and I'm left with only the parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F]
[G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497
0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0 373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

.

.

Morton
There were several changes I needed to make. The new macro is below. I
might have missed something so come back if this isn't right. Note that I
remarked out (put a leading apostrophe) a couple of lines I think are not
needed because the data starts in row 1 and not row 2. Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 31).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
'Set rHeaders = Range("A1", "AE1")
Set rColA = Range("A1", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
'rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A1", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 30 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
Otto,
Your macro worked perfectly! One last question, if my actual dataset
began
in cell A1 and extended to cell AE1, and contained 1,619 rows, what parts
of
your macro would I change? Again, thank you so much - this has really
helped
me out!

"Otto Moehrbach" wrote:

Morton
Unfortunately, posting code often results in line wrapping and VBA is
very intolerant of line wrapping. Below I have placed the first word of
each line of the code to help you in eliminating line wrapping.
Sub
Dim
Dim
Range
Sheets
Set
Set
For
rColA
rHeaders
Next
Set
For
For
If
rColA(c)
End If
Next d
Next c
End Sub
The "Shift:=xlToLeft" belongs after the word "Delete" above it with a
space
between them. HTH Otto
"Morton Detwyler" wrote in
message ...
Hi Otto,
Thanks for your help. Unfortunately, I am getting a €œCompile Error:
Syntax
Error€� and it is highlighting the code €œShift:=xlToLeft€�. Ill await
your
reply.


"Otto Moehrbach" wrote:

Morton
This macro will do what you want. I assumed your data starts in
Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The
code
copies your table from the active sheet to the New Sheet and then does
what
you want to the table in the active sheet. Post back if you need
more.
HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" &
Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and
serial
numbers
in column [A] as shown in Example 1. In the example below (Example
1),
the
range beginning in cell [B2] and ending in cell [H6], is the number
of
days
from that serial number's manufacturing date that a part was
replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another
matrix
to
summarize the data as displayed in Example 2. Where per serial
number,
the
parts that have a "0" are eliminated, and I'm left with only the
parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F]
[G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497
0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0
373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

.

.

Otto,
It worked perfectly....thank you so much for your expertise and help!

"Otto Moehrbach" wrote:

Morton
There were several changes I needed to make. The new macro is below. I
might have missed something so come back if this isn't right. Note that I
remarked out (put a leading apostrophe) a couple of lines I think are not
needed because the data starts in row 1 and not row 2. Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 31).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
'Set rHeaders = Range("A1", "AE1")
Set rColA = Range("A1", Range("A" & Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
'rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A1", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 30 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
Otto,
Your macro worked perfectly! One last question, if my actual dataset
began
in cell A1 and extended to cell AE1, and contained 1,619 rows, what parts
of
your macro would I change? Again, thank you so much - this has really
helped
me out!

"Otto Moehrbach" wrote:

Morton
Unfortunately, posting code often results in line wrapping and VBA is
very intolerant of line wrapping. Below I have placed the first word of
each line of the code to help you in eliminating line wrapping.
Sub
Dim
Dim
Range
Sheets
Set
Set
For
rColA
rHeaders
Next
Set
For
For
If
rColA(c)
End If
Next d
Next c
End Sub
The "Shift:=xlToLeft" belongs after the word "Delete" above it with a
space
between them. HTH Otto
"Morton Detwyler" wrote in
message ...
Hi Otto,
Thanks for your help. Unfortunately, I am getting a €œCompile Error:
Syntax
Error€� and it is highlighting the code €œShift:=xlToLeft€�. Ill await
your
reply.


"Otto Moehrbach" wrote:

Morton
This macro will do what you want. I assumed your data starts in
Column
A in Row 1. I assumed you had a blank sheet named "New Sheet". The
code
copies your table from the active sheet to the New Sheet and then does
what
you want to the table in the active sheet. Post back if you need
more.
HTH
Otto
Sub ReArrange()
Dim rColA As Range, c As Long
Dim d As Long, rHeaders As Range
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
Sheets("New Sheet").Range("A1").PasteSpecial
Set rHeaders = Range("A1", "H1")
Set rColA = Range("A2", Range("A" &
Rows.Count).End(xlUp)).Offset(-1)
For c = rColA.Count To 2 Step -1
rColA(c).Offset(1).EntireRow.Insert
rHeaders.Copy rColA(c).Offset(1)
Next c
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = 1 To rColA.Count Step 2
For d = 7 To 1 Step -1
If rColA(c).Offset(, d) = 0 Then
rColA(c).Offset(, d).Offset(-1).Resize(2).Delete
Shift:=xlToLeft
End If
Next d
Next c
End Sub


"Morton Detwyler" wrote in
message ...
I have a matrix of data that lists part numbers in row [1] and
serial
numbers
in column [A] as shown in Example 1. In the example below (Example
1),
the
range beginning in cell [B2] and ending in cell [H6], is the number
of
days
from that serial number's manufacturing date that a part was
replaced;
i.e.
Serial # 12A had PART2 replaced 528 days after 12A's manufacture.

Leaving the data in Example 1 intact, I need to create another
matrix
to
summarize the data as displayed in Example 2. Where per serial
number,
the
parts that have a "0" are eliminated, and I'm left with only the
parts
that
have been consumed and the elapsed days from manufacturing.

Is there any way possible of doing this?

Thanks so much for your time and assistance.

EXAMPLE 1
¯¯¯¯¯¯¯¯¯¯
COL/ROW [b] [C] [D] [E] [F]
[G]
[H]
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
[1] Serial # PART1 PART2 PART3 PART4 PART5 PART6 PART7
[2] 12A 0 528 0 0 528
0
528
[3] 23B 0 497 157 0 497
0
497
[4] 34C 465 430 0 0 0
0
0
[5] 45D 0 378 0 398 0
0
0
[6] 56E 0 373 0 0
373
0
0


EXAMPLE 2
¯¯¯¯¯¯¯¯¯¯
Serial # PART2 PART5 PART7
12A 528 528 528
Serial # PART2 PART3 PART5 PART7
23B 497 157 497 497
Serial # PART1 PART2
34C 465 430
Serial # PART2 PART4
45D 378 398
Serial # PART2 PART5
56E 373 373

.

.

.