Cell displays what's held in the clipboard

T

TheJay

Active Member
Joined
Nov 12, 2014
Messages
364
Office Version
  1. 2019
Platform
  1. Windows
Hello everyone, I want to create a sheet that has a cell displaying what is being held in the clipboard and it updates whenever the clipboard holds different data. Can someone please tell me if this is possible and if so, how it can be done? The reason for this is because there are multiple cells that the user can copy from and it's useful to see at a glance what is currently held.

Thanks.
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
I've come up with a very basic way, but once the value has been copied to E16, I want the focus to return to the original cell that the data came from?
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("C4:C8,C10,C13,C16,C19,E4,E7,E10,E13")) Is Nothing Then
        Target.Copy
        Range("E16").PasteSpecial Paste:=xlPasteValues
    End If
End Sub
 
Upvote 0
The following code should display the clipboard text (info) content in cells "D16:E17" of Sheet1 along with the currently copied\cut range address.

The code will run automatically everytime the user copies\cut within "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13" of Sheet1.

Code goes in the ThisWorkbook Module:
VBA Code: 
Option Explicit

Private WithEvents oCbarEvents As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
#End If

Private Const TARGET_SHEET As String = "Sheet1"  '<<== change as required
Private Const TARGET_RANGE As String = "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13"  '<<== change as required
Private Const TARGET_INFO_RANGE As String = "D16:E17"  '<<== change as required


Private Sub Workbook_Open()
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long
    Static bFormatted As Boolean
  
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
  
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If bFormatted = False Or IsEmpty(.Range(TARGET_INFO_RANGE)(1)) Then
                        Call FormatInfoRange(bFormatted)
                    End If
                    .Range(TARGET_INFO_RANGE)(2) = ActiveWindow.RangeSelection.Address
                    .Range(TARGET_INFO_RANGE)(4) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
  
End Sub

Private Sub FormatInfoRange(ByRef Formatted As Boolean)
    With Sheets(TARGET_SHEET)
        .Range(TARGET_INFO_RANGE)(1).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(3).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(1).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(1).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(1) = "Address:="
        .Range(TARGET_INFO_RANGE)(3) = "Clipborad text:="
        .Range(TARGET_INFO_RANGE).EntireColumn.AutoFit
    End With
    Formatted = True
End Sub
 
Last edited:
Upvote 0
Jaafar Tribak said:
The following code should display the clipboard text (info) content in cells "D16:E17" of Sheet1 along with the currently copied\cut range address.

The code will run automatically everytime the user copies\cut within "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13" of Sheet1.

Code goes in the ThisWorkbook Module:
VBA Code: 
Option Explicit

Private WithEvents oCbarEvents As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
#End If

Private Const TARGET_SHEET As String = "Sheet1"  '<<== change as required
Private Const TARGET_RANGE As String = "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13"  '<<== change as required
Private Const TARGET_INFO_RANGE As String = "D16:E17"  '<<== change as required


Private Sub Workbook_Open()
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long
    Static bFormatted As Boolean
 
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
 
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If bFormatted = False Or IsEmpty(.Range(TARGET_INFO_RANGE)(1)) Then
                        Call FormatInfoRange(bFormatted)
                    End If
                    .Range(TARGET_INFO_RANGE)(2) = ActiveWindow.RangeSelection.Address
                    .Range(TARGET_INFO_RANGE)(4) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
 
End Sub

Private Sub FormatInfoRange(ByRef Formatted As Boolean)
    With Sheets(TARGET_SHEET)
        .Range(TARGET_INFO_RANGE)(1).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(3).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(1).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(1).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(1) = "Address:="
        .Range(TARGET_INFO_RANGE)(3) = "Clipborad text:="
        .Range(TARGET_INFO_RANGE).EntireColumn.AutoFit
    End With
    Formatted = True
End Sub
Click to expand...
Thank you for your reply.

I'm not sure how to combine as I already have code within OpenWorkbook and it's throwing errors.

"Compile error:

Invalid attribute in Sub or Function" in relation to:

VBA Code: 
Private WithEvents oCbarEvents As CommandBars

VBA Code: 
Private Sub Workbook_Open()
Set oCbarEvents = Application.CommandBars
Application.EnableEvents = False
    Dim Sh As Worksheet
    For Each Sh In Worksheets
        If Sh.Name = "Property Numbering" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C14,C8").ClearContents
            Sh.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
            Sh.Range("C14,C8").Value = "'Choose"
        ElseIf Sh.Name = "VO Areas" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C4").ClearContents
            Sh.Range("C4").Value = "'Choose"
        Else
            Sh.Protect UserInterFaceOnly:=True
        End If
    Next
Application.EnableEvents = True
End Sub

Private WithEvents oCbarEvents As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
#End If

Private Const TARGET_SHEET As String = "Clipboard"
Private Const TARGET_RANGE As String = "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13,G10,G13"
Private Const TARGET_INFO_RANGE As String = "E16"

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long
    Static bFormatted As Boolean
  
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
  
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If bFormatted = False Or IsEmpty(.Range(TARGET_INFO_RANGE)(1)) Then
                        Call FormatInfoRange(bFormatted)
                    End If
                    .Range(TARGET_INFO_RANGE)(2) = ActiveWindow.RangeSelection.Address
                    .Range(TARGET_INFO_RANGE)(4) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
  
End Sub

Private Sub FormatInfoRange(ByRef Formatted As Boolean)
    With Sheets(TARGET_SHEET)
        .Range(TARGET_INFO_RANGE)(1).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(3).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(1).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(1).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(1) = "Address:="
        .Range(TARGET_INFO_RANGE)(3) = "Clipborad text:="
        .Range(TARGET_INFO_RANGE).EntireColumn.AutoFit
    End With
    Formatted = True
End Sub
 
Upvote 0
Attempt two:

VBA Code: 
Option Explicit

Private WithEvents oCbarEvents As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
#End If

Private Const TARGET_SHEET As String = "Clipboard"
Private Const TARGET_RANGE As String = "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13,G10,G13"
Private Const TARGET_INFO_RANGE As String = "E16"

Private Sub Workbook_Open()
    Set oCbarEvents = Application.CommandBars
Application.EnableEvents = False
    Dim Sh As Worksheet
    For Each Sh In Worksheets
        If Sh.Name = "Property Numbering" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C14,C8").ClearContents
            Sh.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
            Sh.Range("C14,C8").Value = "'Choose"
        ElseIf Sh.Name = "VO Areas" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C4").ClearContents
            Sh.Range("C4").Value = "'Choose"
        Else
            Sh.Protect UserInterFaceOnly:=True
        End If
    Next
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long
    Static bFormatted As Boolean
    
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
    
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If bFormatted = False Or IsEmpty(.Range(TARGET_INFO_RANGE)(1)) Then
                        Call FormatInfoRange(bFormatted)
                    End If
                    .Range(TARGET_INFO_RANGE)(2) = ActiveWindow.RangeSelection.Address
                    .Range(TARGET_INFO_RANGE)(4) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
    
End Sub

Private Sub FormatInfoRange(ByRef Formatted As Boolean)
    With Sheets(TARGET_SHEET)
        .Range(TARGET_INFO_RANGE)(1).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(3).VerticalAlignment = xlTop
        .Range(TARGET_INFO_RANGE)(1).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(1).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(3).Font.Bold = True
        .Range(TARGET_INFO_RANGE)(3).Font.Color = vbRed
        .Range(TARGET_INFO_RANGE)(1) = "Address:="
        .Range(TARGET_INFO_RANGE)(3) = "Clipborad text:="
        .Range(TARGET_INFO_RANGE).EntireColumn.AutoFit
    End With
    Formatted = True
End Sub

Error:
ZrXkIAQ.png

VBA Code: 
.Range(TARGET_INFO_RANGE)(1).VerticalAlignment = xlTop
 
Upvote 0
If I unlock the worksheet, it seems to work (not completely):

S1L2vLM.png


I just want to display the content from the clipboard within the blue box, I don't need to reference the original cell or add any additional text.
 
Upvote 0
TheJay said:
If I unlock the worksheet, it seems to work (not completely):
I just want to display the content from the clipboard within the blue box, I don't need to reference the original cell or add any additional text.
Click to expand...

Assuming the display cell is cell E16 in Sheet1. Try the following trimed version:

VBA Code: 
Option Explicit

Private WithEvents oCbarEvents As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
#End If

Private Const TARGET_SHEET As String = "Sheet1"  '<<== change as required
Private Const TARGET_RANGE As String = "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13"  '<<== change as required

Private Const TARGET_INFO_RANGE As String = "E16"  '<<== change as required


Private Sub Workbook_Open()
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub


Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long
  
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
  
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    .Range(TARGET_INFO_RANGE) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
  
End Sub

Note:
Obviously, Cell E16 must be unlocked.
 
Upvote 0
Thank you. That works well.

I don't want anyone to be able to select that cell, so what's the best way to avoid it being clicked or tabbed? Also, if it copies multiple lines of text, double quotes are added. Is there a way to prevent this?

VBA Code: 
Option Explicit

Private WithEvents oCbarEvents As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
#End If

Private Const TARGET_SHEET As String = "Clipboard"
Private Const TARGET_RANGE As String = "C4:C8,C10,C13,C16,C19,E4,E7,E10,E13,G10,G13"
Private Const TARGET_INFO_RANGE As String = "E16"

Private Sub Workbook_Open()
    Set oCbarEvents = Application.CommandBars
Application.EnableEvents = False
    Dim Sh As Worksheet
    For Each Sh In Worksheets
        If Sh.Name = "Property Numbering" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C14,C8").ClearContents
            Sh.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
            Sh.Range("C14,C8").Value = "'Choose"
        ElseIf Sh.Name = "VO Areas" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C4").ClearContents
            Sh.Range("C4").Value = "'Choose"
        Else
            Sh.Protect UserInterFaceOnly:=True
        End If
    Next
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub

Private Sub oCbarEvents_OnUpdate()
    Static lPrevSN As Long
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    .Range(TARGET_INFO_RANGE) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
End Sub
 
Upvote 0
I don't want anyone to be able to select that cell, so what's the best way to avoid it being clicked or tabbed? Also, if it copies multiple lines of text, double quotes are added. Is there a way to prevent this?
Click to expand...
What is the reason you don't want the cell to be clicked or tabbed?

Don't know why double quotes are added but we should be able to remove them .

Replace the above oCbarEvents_OnUpdate event routine with this one:

VBA Code: 
Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long   
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
   
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If InStr(sClipText, Chr(&HA)) Then
                        sClipText = Replace(sClipText, Chr(&H22), "")
                    End If
                   .Range(TARGET_INFO_RANGE) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
   
End Sub
 
Upvote 0
Jaafar Tribak said:
What is the reason you don't want the cell to be clicked or tabbed?

Don't know why double quotes are added but we should be able to remove them .

Replace the above oCbarEvents_OnUpdate event routine with this one:

VBA Code: 
Private Sub oCbarEvents_OnUpdate()

    Static lPrevSN As Long  
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
  
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If InStr(sClipText, Chr(&HA)) Then
                        sClipText = Replace(sClipText, Chr(&H22), "")
                    End If
                   .Range(TARGET_INFO_RANGE) = sClipText
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
  
End Sub
Click to expand...
Thank you, that worked to remove the double quotes.

The reason to prevent the cell being selected is because cells on the worksheet are automatically copied to the clipboard when selected. I don't want anyone to get confused about the fact that the specified cell is for information only.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Auto-Update Problem
Replies
0
Views
257
Diulama1023
D
A
  • Question
Follow a Hyperlink that creates a new Outlook e-mail message by using a VBA Excel Macro.
Replies
8
Views
1K
Agente442
A
W
  • Question
Sheet that updates by referencing cells in workbooks located in separate folders on shared drive
Replies
0
Views
148
Woodpusher147
W
N
  • Solved
Vstack, Chooserows & Dollar
2
Replies
18
Views
356
Nathan Asius
N
C
  • Question
Porting an Excel application to Access
Replies
6
Views
237
chazrab
C

Forum statistics

Threads
1,214,788
Messages
6,121,600
Members
449,038
Latest member
Arbind kumar

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top