right click copy

[aoc]

Hi,

when I select some cells in column C, I will right click and choose 5xxxxxxxxx.

it will copy all the numbers in selected area in format 5xxxxxxxxx.

it means; the number 0534 654 76 17 will be copied as 5346547617. I mean 0 is deleted, there will be no space.

can you please give the code ?

regards

[Aussiebear]

Hi Osman,

I had a couple of reads of your post, and I'm still somewhat confused.

Are you wanting the figure 0534 654 76 17 to be copied as it currently stands, or are you wanting it to be copied as 5346547617?

For future reference, please consider posting a workbook with both a before and after example. This way any misunderstanding from the description of the issue is significantly reduced.

[aoc]

hi,

to be copied as 5346547617

regards,

[slamet Harto]

Hi there

Just try this
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim CbCtrl
With Application
For Each CbCtrl In .CommandBars("cell").Controls
If CbCtrl.Caption = "Changes and remove space" Then CbCtrl.Delete
Next CbCtrl

If Target.Column = 3 Then 'Not .Intersect(Target, Range("A1:L2")) Is Nothing Then
With .CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=5, temporary:=False)
.Caption = "Changes and remove space"
.OnAction = "ReConvert"
End With
End If
End With
End Sub

Sub ReConvert()
Dim Cel As Range, lanjut

lanjut = MsgBox("remove zero & space]" & vbCr & vbCr & _
"Continue ? ", 36, "Removed to value")
If lanjut = vbYes Then
ActiveCell.SpecialCells(xlLastCell).Select
For Each Cel In Range("C1", Selection)
If Left(Cel, 1) = "0" Then
Cel.NumberFormat = "@"

Cel.Value = Trim(Replace(Replace(Cel.Value, Chr(160), ""), " ", ""))
End If

Next
End If

End Sub

hope this help

[aoc]

Hi,

I tried it. but it does not work. Can you please check the attached doc. ?

[slamet Harto]

hmm
no space remove??

paste this code into worksheet module
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim CbCtrl
With Application
For Each CbCtrl In .CommandBars("cell").Controls
If CbCtrl.Caption = "Eliminate Zero" Then CbCtrl.Delete
Next CbCtrl

If Target.Column = 3 Then
With .CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=5, temporary:=False)
.Caption = "Eliminate Zero"
.OnAction = "ReConvert"
End With
End If
End With
End Sub

And this code in module 1
Sub ReConvert()
Dim Cel As Range, lanjut
lanjut = MsgBox("remove zero" & vbCr & vbCr & _
"Continue ? ", 36, "Removed to value")
If lanjut = vbYes Then
ActiveCell.SpecialCells(xlLastCell).Select
For Each Cel In Range("C2", Selection)
If Left(Cel, 1) = "0" Then

Cel.Value = Left(Cel.Value, InStr(Cel.Value, "0") - 1) _
& Right(Cel.Value, Len(Cel.Value) - InStr(Cel.Value, ""))

End If

Next
End If
[A1].Select
End Sub

Sorry, i'm not able to post the workbook.

hope this help

[aoc]

Hi Slamet,

When I right click the cell or cells , I will click for example remove space and zero. It will copy for example;

I will right click 0533 455 66 77 and click remove space and zero, It will copy it as 5334556677. I will paste it or them to another cell. I dont want the cell to be changed from 0533 455 66 77 to 5334556677

can you please revise it ?

regards



hmm
no space remove??

paste this code into worksheet module
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim CbCtrl
With Application
For Each CbCtrl In .CommandBars("cell").Controls
If CbCtrl.Caption = "Eliminate Zero" Then CbCtrl.Delete
Next CbCtrl

If Target.Column = 3 Then
With .CommandBars("cell").Controls _
.Add(Type:=msoControlButton, before:=5, temporary:=False)
.Caption = "Eliminate Zero"
.OnAction = "ReConvert"
End With
End If
End With
End Sub

And this code in module 1
Sub ReConvert()
Dim Cel As Range, lanjut
lanjut = MsgBox("remove zero" & vbCr & vbCr & _
"Continue ? ", 36, "Removed to value")
If lanjut = vbYes Then
ActiveCell.SpecialCells(xlLastCell).Select
For Each Cel In Range("C2", Selection)
If Left(Cel, 1) = "0" Then

Cel.Value = Left(Cel.Value, InStr(Cel.Value, "0") - 1) _
& Right(Cel.Value, Len(Cel.Value) - InStr(Cel.Value, ""))

End If

Next
End If
[A1].Select
End Sub

Sorry, i'm not able to post the workbook.

hope this help