On Sunday, December 23, 2012 11:22:02 PM UTC-8, LearningHorse wrote:[color=blue][i]
Howard;1608209 Wrote:
On Sunday, December 23, 2012 12:59:11 AM UTC-8, LearningHorse
wrote:
Hi LearningHorse,
Give this code a try with the following additions to your worksheet
example..
Select A2:A6 and while selected click in the name box and name the range
P_id.
Select cell A8, then on the ribbon Data Data Valadition Data
Valadation Allow check list click in source window enter =P_id
OK.
Now click cell A8 and see the arrow, click arrow and select a P_id
number. Now run the Macro Sub P_id().
Just in case you need help installing the code, first copy all the code,
right click on the sheet tab and select View Code. Paste the code in
the large white space which is the vb editor. Now you have three ways
to run the code:
1. While in the vb editor make sure the cursor is within the code, that
is between "Sub P_id()" and "End Sub". Look up on the tool bar and find
DeBug and just below the word DeBug see the small trianglular green
arrow (points to the right). Mouse-over the arrow and see "Run Sub/User
Form F5". Either click on the arrow or hit F5 and it will fire the
macro.
2. Back on the worksheet, Alt + Tab or click on the left most icon in
the tool bar which is a small Excel icon just above the word Project,
you can assign the macro to a button. On the ribbon Developer
Insert Forms Controls click the button icon - upper left most icon
and on the worksheet left-click-and-hold while you drag down and right
to the size button you want. Release and see the Assign Macro box,
click on the (your sheet name)P_id then OK. Just click the button to
run the macro.
3. Assign macro to a Short-cut key. Developer Macros Options Ctrl
+ box enter a letter OK. Avoid reserved letters like c - Copy or v
- Paste. Now Ctrl + "your letter" runs the macro.
Wherever you see Sheets("Sheet2"), change to Sheets("your sheet name").
Option Explicit
Sub P_id()
Dim i As Long
Dim c As Range
i = Range("A8")
Application.ScreenUpdating = False
For Each c In Range("P_id")
If c.Value = i Then
c.Offset(0, 1).Resize(1, 24).Copy
Sheets("Sheet2").Range("C1200").End(xlUp).Offset(1 , 0) _
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Range("A8").Offset(-7, 1).Resize(1, 24).Copy
Sheets("Sheet2").Range("B1200").End(xlUp).Offset(1 , 0). _
PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Sheets("Sheet2").Range("A1200").End(xlUp).Offset(1 , 0). _
Resize(24, 1).Value = i
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Good luck and post back if you get hung up.
Regards,
Howard
Hi Howard
Thank you for your reply.
Your proposal was definitely a possible way to solve the problem.
However, if I understand your code right, I have to change the P_id in
the dropdown list for each product. This could work quite well if I had
only two or even ten Products, but I have thousands.
Is it some way to shift the product (P_id) in the dropdownlist
automatically?
Rgds LH
+-------------------------------------------------------------------+
+-------------------------------------------------------------------+
--
LearningHorse
Do away with the drop down list and try this.
In the code find this line
For Each c In Range("A2:A6")
and change the "A2:A6" to suit your sheet, "A2:A5000" for instance.
You can still use a named range if you wish by selecting A2:A5000 and name it P_id. Then uncomment this line 'For Each c In Range("P_id") and discard or comment out For Each c In Range("A2:A5000")
Option Explicit
Sub P_id()
Dim c As Variant
Application.ScreenUpdating = False
'For Each c In Range("P_id")
For Each c In Range("A2:A6")
c.Offset(0, 1).Resize(1, 24).Copy
Sheets("Ark2").Range("C1200").End(xlUp).Offset(1, 0). _
PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Range("A1").Offset(0, 1).Resize(1, 24).Copy
Sheets("Ark2").Range("B1200").End(xlUp).Offset(1, 0). _
PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Sheets("Ark2").Range("A1200").End(xlUp).Offset(1, 0). _
Resize(24, 1).Value = c
Sheets("Ark2").Activate
With Sheets("Ark2").Range("A1200").End(xlUp).Select
End With
Next
Sheets("Ark1").Activate
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Let me know how it goes.
Howard