On Sunday, December 23, 2012 12:59:11 AM UTC-8, LearningHorse wrote:[color=blue][i]
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