I've copied some text in the clipboard and then using the macro below
copy each item into a separate row.


Sub CommandButton2_Click()

Dim MyData As New DataObject
Dim strClip As String
On Error GoTo NotText
MyData.GetFromClipboard
strClip = MyData.GetText
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False,
DisplayAsIcon:= _
False

Rows("2:2").Select
Selection.Copy

Sheets("Results").Select
Application.Goto Reference:="R1C1"
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True

Application.Goto Reference:="R1C1"
ActiveCell.FormulaR1C1 = " " + ActiveCell.FormulaR1C1
' Range("B1").Select

NotText:
'don't want anything to happen if the clipboard is empty
End Sub


Next I need to select the pasted text as a range and to copy
=IF(ISNUMBER(VALUE(LEFT((A1),FIND(" ",TRIM(A1))))),VALUE(LEFT((A1),FIND
(" ",TRIM(A1)))),1)
into the second column of each row

and this in the 3rd column
=TRIM(MID(TRIM(A1),FIND(" ",TRIM(A1)),LEN(A1)))

I'm tryng to use
Set MyRange = Range((Cells(xlFirstRow, xlFirstCol)), (Cells
(xlLastRow, xlLastCol)))
MyRange.Copy Destination:=Sheets("Sheet2").Range("B4")

If you mean the popup menu; try the below

On the active sheet Range("A1:A10") type some values say 1 to 10 and run the
below macro..

Sub Macro()
Dim cell As Range
Dim cbCTLPop As CommandBarPopup, cbCTLBut As CommandBarButton

On Error Resume Next
Application.CommandBars("MyBar").Delete
Application.CommandBars.Add "MyBar", Position:=msoBarPopup, _
Temporary:=True

Set cbCTLPop = Application.CommandBars("MyBar").Controls.Add( _
Type:=msoControlPopup, Temporary:=True)
cbCTLPop.Caption = "My menu"

For Each cell In Range("A1:A10")
Set cbCTLBut = cbCTLPop.Controls.Add(Temporary:=True)
With cbCTLBut
.Caption = cell.Text
.Style = msoButtonCaption
.OnAction = "Macro_" & cell.Text
End With
Set cbCTLBut = Nothing
Next
Application.CommandBars("MyBar").ShowPopup
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"caveman.savant" wrote:

I've copied some text in the clipboard and then using the macro below
copy each item into a separate row.


Sub CommandButton2_Click()

Dim MyData As New DataObject
Dim strClip As String
On Error GoTo NotText
MyData.GetFromClipboard
strClip = MyData.GetText
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False,
DisplayAsIcon:= _
False

Rows("2:2").Select
Selection.Copy

Sheets("Results").Select
Application.Goto Reference:="R1C1"
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True

Application.Goto Reference:="R1C1"
ActiveCell.FormulaR1C1 = " " + ActiveCell.FormulaR1C1
' Range("B1").Select

NotText:
'don't want anything to happen if the clipboard is empty
End Sub


Next I need to select the pasted text as a range and to copy
=IF(ISNUMBER(VALUE(LEFT((A1),FIND(" ",TRIM(A1))))),VALUE(LEFT((A1),FIND
(" ",TRIM(A1)))),1)
into the second column of each row

and this in the 3rd column
=TRIM(MID(TRIM(A1),FIND(" ",TRIM(A1)),LEN(A1)))

I'm tryng to use
Set MyRange = Range((Cells(xlFirstRow, xlFirstCol)), (Cells
(xlLastRow, xlLastCol)))
MyRange.Copy Destination:=Sheets("Sheet2").Range("B4")

Oops..Please ignore the previous post... To your query; if you are looking to
fill in formulas you dont need to take that to clipboard and paste that to
each cell instead you can try the below ...

Dim myRange As Range, lngLastRow As Long

'Find last row of column A
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Fill ColB with formulas
Set myRange = Range("B1:B" & lngLastRow)
myRange.Formula = "=IF(ISNUMBER(VALUE(LEFT((A1),FIND(char(32)," & _
"TRIM(A1))))),VALUE(LEFT((A1),FIND(char(32),TRIM(A 1)))),1)"

'Fill ColC with formulas
Set myRange = Range("C1:C" & lngLastRow)
myRange.Formula = "=TRIM(MID(TRIM(A1),FIND(char(12),TRIM(A1)),LEN(A1 )))"

PS: You get the formulas as a text string and copy that to all cells or if
the formula already resides in the first cell you can use the auto fill
option.

If this post helps click Yes
---------------
Jacob Skaria


"Jacob Skaria" wrote:

If you mean the popup menu; try the below

On the active sheet Range("A1:A10") type some values say 1 to 10 and run the
below macro..

Sub Macro()
Dim cell As Range
Dim cbCTLPop As CommandBarPopup, cbCTLBut As CommandBarButton

On Error Resume Next
Application.CommandBars("MyBar").Delete
Application.CommandBars.Add "MyBar", Position:=msoBarPopup, _
Temporary:=True

Set cbCTLPop = Application.CommandBars("MyBar").Controls.Add( _
Type:=msoControlPopup, Temporary:=True)
cbCTLPop.Caption = "My menu"

For Each cell In Range("A1:A10")
Set cbCTLBut = cbCTLPop.Controls.Add(Temporary:=True)
With cbCTLBut
.Caption = cell.Text
.Style = msoButtonCaption
.OnAction = "Macro_" & cell.Text
End With
Set cbCTLBut = Nothing
Next
Application.CommandBars("MyBar").ShowPopup
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"caveman.savant" wrote:

I've copied some text in the clipboard and then using the macro below
copy each item into a separate row.


Sub CommandButton2_Click()

Dim MyData As New DataObject
Dim strClip As String
On Error GoTo NotText
MyData.GetFromClipboard
strClip = MyData.GetText
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False,
DisplayAsIcon:= _
False

Rows("2:2").Select
Selection.Copy

Sheets("Results").Select
Application.Goto Reference:="R1C1"
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True

Application.Goto Reference:="R1C1"
ActiveCell.FormulaR1C1 = " " + ActiveCell.FormulaR1C1
' Range("B1").Select

NotText:
'don't want anything to happen if the clipboard is empty
End Sub


Next I need to select the pasted text as a range and to copy
=IF(ISNUMBER(VALUE(LEFT((A1),FIND(" ",TRIM(A1))))),VALUE(LEFT((A1),FIND
(" ",TRIM(A1)))),1)
into the second column of each row

and this in the 3rd column
=TRIM(MID(TRIM(A1),FIND(" ",TRIM(A1)),LEN(A1)))

I'm tryng to use
Set MyRange = Range((Cells(xlFirstRow, xlFirstCol)), (Cells
(xlLastRow, xlLastCol)))
MyRange.Copy Destination:=Sheets("Sheet2").Range("B4")