VBA object to copy a row when that row is clicked...

[seandotson]

I have a sheet where I have a series of columns with info. I need the ability to click on a button or object in that row and copy that row (technically a range of that row) to the clipboard.

This could easily be solved with VB object control arrays but those do not exist in VBA.

Any suggestions on how to make this work...(I have the code to make the button copy, need help with the object to use to trigger the code)

A visual example: http://i.imgur.com/3BanpHS.png

 

[sijpie]

If you use a normal button or an activeX shape (button, image or other control), then you can link a macro to these because they have Click events.

the code would then be something like

Private Sub BtnCopy3_Click()
     Range("B57:F57").copy
End Sub

However this means that for each line you need to create a button and link it to a specific line. This is a major piece of duplication and maintenance.

it will be easier if you have only one button (in the header row, which stays in view with panes activated) and act on the row where the selected cell is

Then the code would be:

Private Sub BtnCopy_Click()
    with activecell
        cells(.row,2).resize(1,5).copy
    end with
End Sub

Alternatively you could set it up so that when you double click in a cell in column A (and/or B) the selection is made and copied. If this is for yourself that is fine, for other users it may not be that intuative

 

[seandotson]

The double click method worked. Thanks!

And the data goes to the clipboard. However when I right click to paste there is nothing there to paste.

Here is my code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


On Error Resume Next


Dim CopyData As Range


Set CopyData = Range("C" & Target.Row & ":W" & Target.Row)
CopyData.Copy


End Sub

 

[seandotson]

When you copy a cell manually it plces the dashed lines around it. You can then paste. If you hit ESC the dashed lines disappear and you lose the ability to paste. It's like the code is doing this. Hitting ESC after it runs.

 

[sijpie]

My mistake. To use the clipboard you need to code differntly.

See

Windows Clipboard
VBA-Excel: Putting Text In The Windows Clipboard

 

[seandotson]

My mistake. To use the clipboard you need to code differntly.

See

Windows Clipboard
VBA-Excel: Putting Text In The Windows Clipboard

OK I think I'm almost there. (and thank you for the help so far) I got their sample code working but it only puts text in the clipboard. I need to put all the data from a range of cells.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


Dim CopyData As Range
Dim objData As New MSForms.DataObject


On Error Resume Next


'MsgBox Target.Address & " " & Target.Row
Set CopyData = Range("c" & Target.Row & ":W" & Target.Row)

objData.SetText CopyData
objData.PutInClipboard


End Sub

objData does not seem to have a .setRange or such command.

 

[seandotson]

I'm so close. Any help would be appreciated...

 

[Jaafar Tribak]

See if this works for you :

1- Add a new Standard Module to your VbProject and place the following in it :

Option Explicit

Private Declare Function OpenClipboard Lib "user32" ( _
        ByVal hwnd As Long _
        ) As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function CallNextHookEx _
        Lib "user32" ( _
        ByVal hHook As Long, _
        ByVal ncode As Long, _
        ByVal wParam As Long, _
        lParam As Any) _
        As Long

Private Declare Function SetWindowsHookEx Lib "user32" _
        Alias "SetWindowsHookExA" ( _
        ByVal idHook As Long, _
        ByVal lpfn As Long, _
        ByVal hmod As Long, _
        ByVal dwThreadId As Long) _
        As Long

Private Declare Function UnhookWindowsHookEx _
        Lib "user32" ( _
        ByVal hHook As Long) _
        As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetTimer Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nIDEvent As Long) As Long
        
Private Const WH_CBT = 5
Private Const HCBT_CREATEWND = 3
Private Const HC_ACTION = 0
Private hHook As Long


Public Sub PreserveClipBoardData()
    OpenClipboard Application.hwnd
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookFunc, 0, GetCurrentThreadId)
End Sub

Private Function HookFunc(ByVal hCode As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long

    If hCode = HCBT_CREATEWND Then
        SetTimer Application.hwnd, 0, 1, AddressOf TimerProc
        HookFunc = -1
    End If
    CallNextHookEx hHook, hCode, wParam, lParam
End Function

Private Sub TimerProc()
    KillTimer Application.hwnd, 0
    CloseClipboard
    UnhookWindowsHookEx hHook
End Sub

2- This goes in the worksheet modulle :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim CopyData As Range
    On Error Resume Next
    Set CopyData = Range("C" & Target.Row & ":W" & Target.Row)
    CopyData.Copy
    Call PreserveClipBoardData
End Sub

 

[seandotson]

Thank you so much. This works wonderful... There is only one small issue remaining.. When pasting I get this message. It's because I have formulas in the sheet from which I am copying. Any way to get around this?

2015-04-08_1433 - sdotson's library

The only other way I could get around this is to be able to copy non adjacent cells and paste them non adjacently in the other sheet...

 

[Jaafar Tribak]

It seems that formulas cannot be preserved using the above approach .. Do you need to paste the formulas as well ? or just the values and formattings ?