Search code examples
excelvba

How to get copied range address in VBA?


Background

Let's say I copy a range. In Excel, the copied range will be highlighted with a dashed border. Then I select another cell.
Now I will run a macro. In a message box, I want to see the address of the copied range.

Example:

  1. Copied Range("$A$1:$A$5") and selected the B1 cell. When I run the macro, the message box shows $A$1:$A$5.
  2. Copied Range("$C$5:$E$10") and selected the B1 cell. When I run the macro, the message box shows $C$5:$E$10.
sub GetCopiedAddress()

Dim CopiedRange as Range

'Set CopiedRange = Here Copied range will be mentioned.

MsgBox CopiedRange.Address 'Here Copied range will be shown

End sub

Solution

  • This method is by windows API. Paste as link method is very slow when you will copy a full column. This code works in 64bit. Didnot check in 32bit. Oddclock posted this amazing code.

        Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
        Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongLong) As Long
        Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
        Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
        Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
        Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
        Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
        Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    
    'reads excel copy-paste range from the clipboard and returns range object or nothing if not found
    '_2022_03_19
    Function fGetClipboardRange() As Range  'get excel copy or cut range from clipboard
    Dim strClipboard As String  'raw clipboard data
    Dim arrClipboard() As String    'parse into an array
        Set fGetClipboardRange = Nothing    'default is nothing
        
        strClipboard = fGetClipboardData("link")    'get the link data string
        If strClipboard = "" Then Exit Function 'done if it's empty
        arrClipboard = Split(strClipboard, Chr(0))  'else parse at null characters
        If arrClipboard(0) <> "Excel" Then Exit Function    'excel should be first
        strClipboard = "'" & arrClipboard(1) & "'!" & arrClipboard(2)   'parse the range from the others
        strClipboard = Application.ConvertFormula(strClipboard, xlR1C1, xlA1)   'convert to a1 style
        Set fGetClipboardRange = Range(strClipboard)    'range needs a1 style
    
    End Function
    'read clipboard for specified format into string or null string
    '_2022_03_19
    Function fGetClipboardData(strFormatId As String) As String 'read clipboard into string
    Dim arrData() As Byte   'clipboard reads into this array
    Dim hMem As LongPtr 'memory handle
    Dim lngPointer As LongPtr   'memory pointer
    Dim lngSize As Long 'size on clipboard
    Dim lngFormatId As Long 'id number, for format name
        fGetClipboardData = ""  'default
    
        lngFormatId = fGetClipboardFormat(strFormatId)  'get format
        If lngFormatId <= 0 Then Exit Function  'zero if format not found
    
        CloseClipboard  'in case clipboard is open
        If CBool(OpenClipboard(0)) Then 'open clipboard
            hMem = GetClipboardData(lngFormatId)    'get memory handle
            If hMem > 0 Then    'if there's a handle
                lngSize = CLng(GlobalSize(hMem))    'get memory size
                If lngSize > 0 Then 'if we know the size
                    lngPointer = GlobalLock(hMem)   'get memory pointer
                    If lngPointer > 0 Then  'make sure we have the pointer
                        ReDim arrData(0 To lngSize - 1) 'size array
                        CopyMemory arrData(0), ByVal lngPointer, lngSize    'data from pointer to array
                        fGetClipboardData = StrConv(arrData, vbUnicode) 'convert array to string
                    End If
                    GlobalUnlock hMem   'unlock memory
                End If
            End If
        End If
        CloseClipboard  'don't leave the clipboard open
        
    End Function
    
    'return verified format number for format number, format number from format name or 0 for not found
    '_2022_03_19
    Function fGetClipboardFormat(strFormatId As String) As Long 'verify, or get format number from format name
    Dim lngFormatId As Long 'format id number
        fGetClipboardFormat = 0 'default false
    
        If IsNumeric(strFormatId) Then  'for format number
            lngFormatId = CLng(strFormatId) 'use number for built in format
            CloseClipboard  'in case clipboard is already open
            If CBool(OpenClipboard(0)) = False Then 'done if can't open clipboard
            ElseIf CBool(IsClipboardFormatAvailable(lngFormatId)) = True Then   'true if format number found
                fGetClipboardFormat = lngFormatId   'return format number
            End If
            CloseClipboard  'don't leave the clipboard open
        Else
            lngFormatId = RegisterClipboardFormat(strFormatId & Chr(0)) 'else get number from format name
            If (lngFormatId > &HC000) Then fGetClipboardFormat = lngFormatId   'if valid return format number
        End If
    
    End Function
    
    Sub test()
    If Application.CutCopyMode Then CopyRefEditTB.Value = fGetClipboardRange.Address
    End Sub