Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
GeorgianaBC Profile
 | Femeie
23 ani
Bacau
cauta Barbat
28 - 80 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Found various solutions for this (late binding, non late binding etc.) but none worked, they would paste ?? instead of my sum.
The simplest way to do this is with the following snippet:
Sub SUM_Selection_toClipboard()
Application.ScreenUpdating = False
[A1] = Application.WorksheetFunction.Sum(Selection)
[A1].Copy
Application.ScreenUpdating = True
End Sub |
Just add a button to QAT or ribbon linking to the above code, select the desired cells and then click paste in the desired location to paste the sum of the selected cells.
****
Updated my code to also include concatenating 2 cells in a selection (just 2, not more). The code above is included in an if clause.
This code can return errors - eg if I want to concatenate 2 cells of which the first is numeric, but I have specific things I sum or concatenate. An update will be added later (TBA).
Sub SUM_Selection_toClipboard()
Application.ScreenUpdating = False
Dim mrg As String
Dim rng As Range
Set rng = Selection
If IsNumeric(rng.Item(1)) Then
[ZZ1] = Application.WorksheetFunction.Sum(Selection)
[ZZ1].Copy
Else
If rng.Cells.count > 2 Or rng.Cells.count = 1 Then
MsgBox "One cell selected, or more than 2 cells selected. Nothing happens."
Exit Sub
ElseIf rng.Cells.count = 2 Then
mrg = rng.Item(1) & " " & rng.Item(2)
[ZZ1].Value = mrg
[ZZ1].Copy
End If
End If
Application.ScreenUpdating = True
End Sub
|
Other solutions sources:
|
|
| pus acum 3 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
updated the code with the lines in gold
when you press enter it will change the formatting of the cell you were on, just don't press enter
Application.CutCopyMode = False will make the code stop working
|
|
| pus acum 7 luni |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Updated code to include the possibility to concatenate the values of 2 cells with a divider (space character). Eg. I have first name in one cell and last name in another cell and want them concatenated.
Eg.
A1 = John
B1 = Smith
The function will put in ZZ1 and clipboard:
John Smith
...for me to paste in another program.
If first cell in selection is numeric, it will sum all cells to cell ZZ1 and copy to clipboard - ready to paste.
Else, if only 1 cell selected, or if more than 2 cells selected, it will return error message and exit sub.
Else, if 2 cells selected, they will be concatenated and divided by a space into cell ZZ1 and copied to clipboard - ready to paste.
|
|
| pus acum 4 luni |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Different approach so that you don't have to replace cell A1/ZZ1 contents.
Instead, the code below will display the sum an an InputBox, then you have to CTRL+C and paste in the desired location:
strClip must be declared as Double in order to have decimals.
Sub SUM_Selection_toClipboard()
Application.ScreenUpdating = False
Dim DataObj As MsForms.DataObject
Dim strClip As Double
Set DataObj = New MsForms.DataObject
strClip = Application.WorksheetFunction.Sum(Selection)
DataObj.SetText strClip
DataObj.PutInClipboard
DataObj.GetFromClipboard
InputBox "Sum is:", "Sum", DataObj.GetText(1)
Application.ScreenUpdating = True
End Sub |
Source:
|
|
| pus acum 2 luni |
|