table problem

  • Thread starter Thread starter Summer
  • Start date Start date
S

Summer

I have a table with three columns of data. Column A contains a part
number such as "Part XX", or "Part ZZ". Column B has a date in the
01/01/05 format. Column C has a numeric value. There are about 20,000
rows of data. The dates cover three years. For example:

PartXX 1/1/05 123
Part XX 3/7/05 456
PartZZ 9/10/07 789
PartXX 1/1/06 159
PartXX 1/1/07 234

Eart part only has one entry for each date during the year.

In the fourth column I'll add a column with all 365 days for the year.
The date will be in the 1/1, 1/2, 1/3 format.

I want to create an output which searches for the specific part and
places the numeric value in the row with the matching date. Using the
above data, columns 4 through 7 would look like this:

1/1 123 156 234

And so on for each date. It's also possible that some dates will not
be present for all parts. So it needs to put a zero in the cell.

Any ideas how to do this?
 
I have a table with three columns of data. Column A contains a part
number such as "Part XX", or "Part ZZ". Column B has a date in the
01/01/05 format. Column C has a numeric value. There are about 20,000
rows of data. The dates cover three years. For example:

PartXX 1/1/05 123
Part XX 3/7/05 456
PartZZ 9/10/07 789
PartXX 1/1/06 159
PartXX 1/1/07 234

Eart part only has one entry for each date during the year.

In the fourth column I'll add a column with all 365 days for the year.
The date will be in the 1/1, 1/2, 1/3 format.

I want to create an output which searches for the specific part and
places the numeric value in the row with the matching date. Using the
above data, columns 4 through 7 would look like this:

1/1 123 156 234

And so on for each date. It's also possible that some dates will not
be present for all parts. So it needs to put a zero in the cell.

Any ideas how to do this?

Not totally clear what you want, but POSSIBLY a pivot table would do
it for you?
 
One set-up which could get you there ..

Illustrated in this sample at:
http://www.savefile.com/files/879778
Auto-Arrange data by day of mth horizontally.xls

In a sheet: X,
Source data is assumed in cols A to C, from row1 down. Real dates are
assumed in col B. D1:D60 contains the list of filled dates (real dates)
1-Jan-04 to 29-Feb-04, custom formatted as: d/m. A leap year 2004 is used to
get the full run of 29 days for Feb.

Put in E1:
=IF($B1="","",IF(TEXT($B1,"d/m")=TEXT(INDEX($D:$D,COLUMNS($A:A)),"d/m"),ROW(),""))
Copy E1 across by 60* cols to BL1, fill down to the extent of source data
*corresponding to the 60 dates in D1:D60

In another sheet: Y,
A1:A60 contains the pasted list from D1:D60. Here, these are just
day-of-year labels which are not read by any formulas.

Put in B1:
=IF(ISERROR(SMALL(OFFSET(X!$D:$D,,ROWS($1:1),),COLUMNS($A:A))),"",INDEX(X!$C:$C,SMALL(OFFSET(X!$D:$D,,ROWS($1:1),),COLUMNS($A:A))))
Copy B1 across by 10 cols (assuming there's a max expected 10 items per any
single day of the year) to K1, then fill down to K60. Cols B to K will
return the required results for 1/1 to 29/2, all neatly bunched to the left.

Extend to suit. Due to the cols limit of 256**, you could do say, the 1st
half year Jan to Jun in one file. Then in a duplicated copy, do the 2nd half
Jul to Dec (just re-fill the dates to start from 1-Jul-04 in X's D1).
**up to xl2003
 
There are about 20,000 rows of data.
Agreed. But the important thing is that the set-up will work right through
xx rows of data. OP can always set the book to manual calc mode, and press
F9 to have it calculate over lunch break ..

btw, I'm also staking out here for other better, speedier responses by
others via formulas or vba.

---
 
HI

The following 2 macros will perform the task, If I have understood the
OP's requirements.
The first macro SETUPDATA will set up heading on an inserted row.
In column D a formula will be inserted, to take the TEXT(A1,"mm/yy") so
that we can sort by that column and get all same dates, regardless of
year, together.
The macro then sorts the data and applies an Autofilter to A1:D1
This needs to be run just once, or when further data is added to the
20,000 rows.

The second macro needs to be run after the User has used the dropdown on
column A Autofilter, to select the Part number required. This cycles
through the visible rows and fills in data in columns F through I for
the numbers associated with that part for each day of the year. The
Autofilter is removed at the end of the macro, so all lines of data are
visible again.
The OP said there was only 1 item of data per year for any given date,
so the numbers are created in columns G, H and I.
The code can be easily adjusted to deal with more years if necessary.

'----------------------------------------------------------------------------------------------------------------
Sub Setupdata()

Dim i As Long, j As Long, k As Long, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

If Range("D1").Value <> "Month/Day" Then
Rows("1:1").Insert Shift:=xlDown
Range("A1") = "Part": Range("B1") = "Date": Range("C1") = "Number":
Range("D1") = "Month/Day"
Range("A1:D1").AutoFilter
End If

Range("D1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mm/dd"")"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D" & lr),
Type:=xlFillDefault
Range("A1:D" & lr).Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending,
Key2:=Range("A1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

End Sub
'=========================================================================

'-------------------------------------------------------------------------------------------------------------------------------------
Sub copydata()
Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value

Cells(k, 7) = Cells(i, 3).Value
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
Cells(k, 8) = Cells(i + 1, 3).Value
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
Cells(k, 9) = Cells(i + 1, 3).Value
i = i + 1
End If

k = k + 1
End If

Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End Sub
'==========================================================================

You can copy the code and paste it into your Visual Basic Editor
(VBE) in a Standard Module located in your file.

To do this,

Alt + F11 (open VBE)
Ctrl + R (open Project Explorer)
Select the file name on the left
Insert > Module
Paste code in Module

To run the macro, Tools>Macro>Macros>Select the macro>Run.

If you want to create a shortcut, then Tools>Macros>Select the
macro>Options>enter a key to use with Ctrl>OK


If you are new to entering macros, then David McRitchie has lots of
useful help on his site at
http://www.mvps.org/dmcritchie/excel/install.htm
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
Roger, thanks for your vba offering.

I'm not sure whether the OP would be responding further to us
(it doesn't look like this is going to happen ..)

I had read it that col A (part XX, etc) actually plays no part in deriving
the required outputs, ie the listing of all numeric values in source col C
going by the day/mth in col B matched against a full vertical listing of all
366 days in a year. Any numeric values having the same day/mth were to be
listed horizontally from left to right (as illustrated in the OP's posting).
I had assumed a max horiz "draw-out" of up to 10 different numeric values in
source col C per any single day of the year.

How could your sub/s be modified to produce the same kind of output as per
my interp above?

---
 
Hi Max
which searches for the specific part and places the numeric value in
the row with the matching date
I took it, that part was to be input (in my case selected from
Autofilter dropdown) and just the values for the three years to be shown
alongside each date.
The OP said there was only one part per year per day and some days might
be missing.
My macro will produce a result for each day that a part exists, but if I
understand the OP correctly, then there can only be 3 columns not 10.
In fact, if one were going to just list all numbers for a single day,
then there would be approximately 55 (20000/365(6))

Nonetheless, to achieve what you are suggesting, I think the following
(untested) code will do that. Note I have set the loop to 55, not to 10
In this case the sort of the original date would have to be made just on
column D, so all of the data is in Month/Day order.

'--------------------------------------------------------------------------------------
Sub copydata2()
Dim userange As Range, i As Long, k As Long
Dim lr As Long, j As Long, h As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:BG").EntireColumn.Delete
Set userange = Range(Cells(2, 1), Cells(lr, 4))
k = 2

For i = 2 To lr

Cells(k, 6) = Cells(i, 4).Value: Cells(k, 7) = Cells(i, 3).Value
h = 8
For j = i To i + 55

If Cells(j + 1, 4) <> Cells(j, 4) Then
k = k + 1
i = j
Exit For
End If
Cells(k, h) = Cells(j + 1, 3).Value
j = j + 1: h = h + 1

Next j
k = k + 1
i = j

Next i

End Sub
'===========================================

I have to go out for the day right now, so don't have time to do any
more, but if this doesn't work, or if you need anyrhing else, post back
and I will check in this evening.
 
Roger, thanks for the response and the sub. I tried it based on the extended
test source data (cols A to C in sheet: X) in the sample file provided to
the OP, but it doesn't quite give the same outputs.

You may well be right on your reading of the original posting.
Let's leave it for the OP to respond further.

---
 
Sorry all. I've had had a really bad summer cold all week and have
lacked the energy to reply. I did read your posts and tried your
suggestions. But I couldn't get the results I was looking for. I think
I did a poor job of explaining what I wanted. I've posted a file at
the following url:

earthstorm.com/test/Usage.xls

Columns A, B and C are the data. Column E is the date. Yhe format is
M/D, but if you click on a cell it actually M/D/Y. Columns F, G, and H
are the desired output from the data.I want to type the desired part
number in F2 and have the formulas in F, G and H find the results.
I've only entered 4 lines of output, but I think you'll get the idea.

In addition to the suggestions you've offered, I've also tried several
combinations of IF, VLOOKUP, AND, and ISNA.

For example. I tried using AND to first search for the part number and
then the matching date:

=IF(AND(VLOOKUP($F$5,A8:C3829,3,),VLOOKUP(E8,B8:C3829,2,))=TRUE,.....
etc

The above isn't complete, but you get the idea. Another problem I've
had is getting the N/A when there isn't a Qty Used. I need it to put a
zero in those cells.

Any other suggestions?
 
Based on your set-up in your sample:
earthstorm.com/test/Usage.xls

Array-enter in F8, ie press CTRL+SHIFT+ENTER to confirm the formula:
=IF(ISNA(MATCH(1,($A$8:$A$4000=$F$5)*(TEXT($B$8:$B$4000,"m/d")=TEXT($E8,"m/d"))*(YEAR($B$8:$B$4000)=F$7),0)),0,INDEX($C$8:$C$4000,MATCH(1,($A$8:$A$4000=$F$5)*(TEXT($B$8:$B$4000,"m/d")=TEXT($E8,"m/d"))*(YEAR($B$8:$B$4000)=F$7),0)))

Copy F8 across to H8, fill down to return desired results. Adapt the ranges
to suit. Above assumes your source data is within rows 8 to 4000.

Visually check that formula is correctly array-entered. Excel will wrap
curly braces { } around the formula in the formula bar. Ensure this is the
case before you copy F8 across / fill down.
 
Hi

The following, slightly modified code from my first posting will work
for you.
First, delete rows 1:7 from your worksheet, then run the first macro.

Use the dropdown arrow on column A, to select the Part number required,
and you will have the data set out in the way that you want. Note that a
0 will appear where there is a 0 in the source data, but the cell will
be blank if there is no data recorded.
Also, the routine only shows the dates where data exists in any year,
rather than showing a long list of empty dates with just a few entries
(as is the case for some of your parts).
If you need every date listed, post back and the macro can be modified.

Sub Setupdata()

Dim i As Long, j As Long, k As Long, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

If Range("D1").Value <> "Month/Day" Then
Rows("1:1").Insert Shift:=xlDown
Range("A1") = "Part Number": Range("B1") = "Eff Date": Range("C1") =
"Qty Used":
Range("D1") = "Month/Day"
Range("A1:D1").AutoFilter
End If

Range("D1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mm/dd"")"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D" & lr),
Type:=xlFillDefault
Range("A1:D" & lr).Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending,
Key2:=Range("A1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
'=========================================================================

'-------------------------------------------------------------------------------------------------------------------------------------
Sub copydata()
Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long, y As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Application.ScreenUpdating = False
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
Cells(1, 7) = 2005: Cells(1, 8) = 2006: Cells(1, 9) = 2007

k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If

k = k + 1
End If
Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Instructions for copying code were included in my original posting.

If you wanted to, you could copy the second macro to a Worksheet
instead, and have it triggered automatically when you make your
selection from the dropdown.

Instead of copying the sub CopyData to a regular module, copy the
following to the worksheet concerned.
Right click on the sheet tab and paste the code below into the white
pane.
Now, when you make a selection for the dropdown in column A, the macro
will get triggered and show your results for that part number.

Private Sub Worksheet_Calculate()
If WorksheetFunction.CountA(Columns("A:A")) = _
WorksheetFunction.Subtotal(3, Columns("A:A")) Then Exit Sub

Application.EnableEvents = False

Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long, y As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Application.ScreenUpdating = False
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
Cells(1, 7) = 2005: Cells(1, 8) = 2006: Cells(1, 9) = 2007

k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If

k = k + 1
End If
Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub

If you have trouble in doing this for yourself, send me your email
address and I will mail a working copy to you.
To mail me direct
roger AT technologyNOSPAM4u.co.U.K.
do the obvious with AT and remove NOSPAM from the address
 
That worked quite well. Thank you.

I was surprised at how long it took (about a minute) to populate the
cells. Maybe I need a faster computer.
 
Roger - I've sent you an email.

Thanks

Hi

The following, slightly modified code from my first posting will work
for you.
First, delete rows 1:7 from your worksheet, then run the first macro.

Use the dropdown arrow on column A, to select the Part number required,
and you will have the data set out in the way that you want. Note that a
0 will appear where there is a 0 in the source data, but the cell will
be blank if there is no data recorded.
Also, the routine only shows the dates where data exists in any year,
rather than showing a long list of empty dates with just a few entries
(as is the case for some of your parts).
If you need every date listed, post back and the macro can be modified.

Sub Setupdata()

Dim i As Long, j As Long, k As Long, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

If Range("D1").Value <> "Month/Day" Then
Rows("1:1").Insert Shift:=xlDown
Range("A1") = "Part Number": Range("B1") = "Eff Date": Range("C1") =
"Qty Used":
Range("D1") = "Month/Day"
Range("A1:D1").AutoFilter
End If

Range("D1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mm/dd"")"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D" & lr),
Type:=xlFillDefault
Range("A1:D" & lr).Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending,
Key2:=Range("A1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
'=========================================================================

'-------------------------------------------------------------------------------------------------------------------------------------
Sub copydata()
Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long, y As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Application.ScreenUpdating = False
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
Cells(1, 7) = 2005: Cells(1, 8) = 2006: Cells(1, 9) = 2007

k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If

k = k + 1
End If
Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Instructions for copying code were included in my original posting.

If you wanted to, you could copy the second macro to a Worksheet
instead, and have it triggered automatically when you make your
selection from the dropdown.

Instead of copying the sub CopyData to a regular module, copy the
following to the worksheet concerned.
Right click on the sheet tab and paste the code below into the white
pane.
Now, when you make a selection for the dropdown in column A, the macro
will get triggered and show your results for that part number.

Private Sub Worksheet_Calculate()
If WorksheetFunction.CountA(Columns("A:A")) = _
WorksheetFunction.Subtotal(3, Columns("A:A")) Then Exit Sub

Application.EnableEvents = False

Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long, y As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Application.ScreenUpdating = False
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
Cells(1, 7) = 2005: Cells(1, 8) = 2006: Cells(1, 9) = 2007

k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If

k = k + 1
End If
Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub

If you have trouble in doing this for yourself, send me your email
address and I will mail a working copy to you.
To mail me direct
roger AT technologyNOSPAM4u.co.U.K.
do the obvious with AT and remove NOSPAM from the address
 
Summer said:
That worked quite well. Thank you. Welcome

I was surprised at how long it took (about a minute) to populate the
cells. Maybe I need a faster computer.
Yes, it does take awhile to recalc. but one minute isn't that bad <g>
You could switch calc mode to manual, then press F9 to recalc when ready

---
 
I think you can do this with some code, but not a formula. Each letter
with the accent mark has an ASCII value. You can write a code to
search for all the ASCII values that have letters with an accent and
replace them with the same letter without an accent. I don't write
code. Perhaps someone else can help you with that part.



Hi

The following, slightly modified code from my first posting will work
for you.
First, delete rows 1:7 from your worksheet, then run the first macro.

Use the dropdown arrow on column A, to select the Part number required,
and you will have the data set out in the way that you want. Note that a
0 will appear where there is a 0 in the source data, but the cell will
be blank if there is no data recorded.
Also, the routine only shows the dates where data exists in any year,
rather than showing a long list of empty dates with just a few entries
(as is the case for some of your parts).
If you need every date listed, post back and the macro can be modified.

Sub Setupdata()

Dim i As Long, j As Long, k As Long, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

If Range("D1").Value <> "Month/Day" Then
Rows("1:1").Insert Shift:=xlDown
Range("A1") = "Part Number": Range("B1") = "Eff Date": Range("C1") =
"Qty Used":
Range("D1") = "Month/Day"
Range("A1:D1").AutoFilter
End If

Range("D1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mm/dd"")"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D" & lr),
Type:=xlFillDefault
Range("A1:D" & lr).Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending,
Key2:=Range("A1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
'=========================================================================

'-------------------------------------------------------------------------------------------------------------------------------------
Sub copydata()
Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long, y As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Application.ScreenUpdating = False
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
Cells(1, 7) = 2005: Cells(1, 8) = 2006: Cells(1, 9) = 2007

k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If

k = k + 1
End If
Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Instructions for copying code were included in my original posting.

If you wanted to, you could copy the second macro to a Worksheet
instead, and have it triggered automatically when you make your
selection from the dropdown.

Instead of copying the sub CopyData to a regular module, copy the
following to the worksheet concerned.
Right click on the sheet tab and paste the code below into the white
pane.
Now, when you make a selection for the dropdown in column A, the macro
will get triggered and show your results for that part number.

Private Sub Worksheet_Calculate()
If WorksheetFunction.CountA(Columns("A:A")) = _
WorksheetFunction.Subtotal(3, Columns("A:A")) Then Exit Sub

Application.EnableEvents = False

Dim userange As Range, visrow As Long, i As Long, k As Long
Dim lr As Long, y As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
Columns("F:I").EntireColumn.Delete
Application.ScreenUpdating = False
Set userange = Range(Cells(2, 1), Cells(lr, 4))
visrow = Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Row
Cells(1, 6) = Cells(visrow, 1)
Cells(1, 7) = 2005: Cells(1, 8) = 2006: Cells(1, 9) = 2007

k = 2
For i = visrow To lr
If Rows(i).EntireRow.Hidden = False Then

Cells(k, 6) = Cells(i, 4).Value
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If
If Cells(i + 1, 1) = Cells(i, 1) And Cells(i + 1, 4) = Cells(i, 4) Then
y = Year(Cells(i, 2)) - 1998
Cells(k, y) = Format(Cells(i, 3).Value, "#,##0")
i = i + 1
End If

k = k + 1
End If
Next i
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub

If you have trouble in doing this for yourself, send me your email
address and I will mail a working copy to you.
To mail me direct
roger AT technologyNOSPAM4u.co.U.K.
do the obvious with AT and remove NOSPAM from the address
 
Back
Top