Home > database >  VBA Excel - Copy autosum data from MsgBox or clipboard
VBA Excel - Copy autosum data from MsgBox or clipboard

Time:12-13

I have my values summarized in Excel by this code:

 Sub AutoSum()
 Dim Sumcalc As Integer
 Range("E" & Cells(Rows.Count, "E").End(xlUp).Row   1).Value = _
 WorksheetFunction.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row))

 MsgBox (Application.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row)))
    
 End Sub

and they appear in Msgbox fine. The problem is, that I can't copy this result from there at all.

I tried to change my Msgbox to something like userform with the field

Selectable Text in VBA Message Box

https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard

and my code finally looks like this:

 Sub AutoSum()
 Dim Sumcalc As Integer
 Range("E" & Cells(Rows.Count, "E").End(xlUp).Row   1).Value = _
 WorksheetFunction.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row))

 Sumcalc = Application.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row))
 Clipboard =.GetData(Sumcalc)
 MsgBox ("Copy to clipboard","Copy Text", Sumcalc)
 
 End Sub

but I am getting an error:

Invalid or unqualified reference for .GetData

In the Msgbox I can't pass a defined variable, just a text value.

How could I copy my Msgbox result to the clipboard or at least making it selectable?

CodePudding user response:

Put the Sum in the Clipboard

Sub SumCatcher()
    
    ' Define constants.
    Const PROC_TITLE As String = "Sum Catcher"
    
    ' Reference the worksheet
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
     
    ' Reference the Source range.
    Dim srg As Range
    Set srg = ws.Range("E2:E", ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' Calculate the sum.
    Dim SumCalc As Double, ErrNum As Long
    On Error Resume Next ' prevent error if any cell contains an error
        SumCalc = Application.Sum(srg)
        ErrNum = Err.Number
    On Error GoTo 0
    
    ' Check if the sum was calculated.
    If ErrNum <> 0 Then
        MsgBox "Could not get the sum. Check that no cell contains an error.", _
            vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    ' Reference the first cell below the Source range, the Destination cell.
    Dim dCell As Range: Set dCell = srg.Cells(1).Offset(srg.Rows.Count)
    
    ' Write the sum to the Destination cell.
    dCell.Value = SumCalc
     
    ' Using a late-bound DataObject, write the sum to the clipboard.
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText SumCalc
        .PutInClipboard
    End With
    
    ' Inform.
    MsgBox "The sum is " & SumCalc & ". Use Ctrl V to paste it.", _
        vbInformation, PROC_TITLE
    
End Sub
  • Related