Hi,
I have a simple requirement to enable my users to select a cell then
drag it onto another cell.

I need to trap the source and destination cells.
How do I do this in excel 2000 onwards?

Many Thanks,
Peter

Well Peter, it is not so "Simple" requirement. There is no standard
event available for Cell drag & drop.

I am giving you below the code for trapping this event and knowing the
source and destination address. It will work only when a single cell is
dragged, if multiple sells are dragged the code would do nothing.

It has to be made in many parts. First of all all the cells have to
identified by some means so that even when there are dragged and dropped
this identification will remain same. For this I used .ID property. All
used cells must be assigned a unique ID. This has to be done in
workbook_open event + worksheet_change event. I am assuming the sheet
name is "Sheet1". Public vairables are required and a function to find a
number is odd or not is required.

1. Insert a moudle in VBA project and in the module cut and pase below
code:

Public strAdd1 As String, strAdd2 As String, usedCount As Long
Public strID1 As Long, strID2 As Long, scCount As Long
Public idCount As Long

Public Function IsOdd(numB As Long) As Boolean
Dim tempnumB
tempnumB = numB / 2
If InStr(1, tempnumB, ".") 0 Then
IsOdd = True
Else
IsOdd = False
End If
End Function



2. Put following in Thisworkbook class, Workbook_Open event procedu

Private Sub Workbook_Open()
Dim c
idCount = 1
For Each c In Worksheets("Sheet1").UsedRange.Cells
c.ID = idCount
idCount = idCount + 1
Next c
usedCount = Worksheets("Sheet1").UsedRange.Cells.Count
If ActiveSheet.Name = "Sheet1" Then
If Len(Selection.ID) 0 Then
strAdd2 = Selection.Address
strID2 = Selection.ID
End If
End If

End Sub

3. Put this in the Sheet1 class, Worksheet_Change event procedure, to
trap change in UsedRange and assign ID to new cells.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c
If Sheet1.UsedRange.Cells.Count < usedCount Then
For Each c In Sheet1.UsedRange.Cells
If Len(c.ID) = 0 Then
c.ID = idCount
idCount = idCount + 1
End If
Next c
usedCount = Sheet1.UsedRange.Cells.Count
End If
End Sub


4. Put this in the Sheet1 class, Worksheet_Activate event procedu

Private Sub Worksheet_Activate()
If Selection.Cells.Count 1 Then Exit Sub
If Len(Selection.ID) = 0 Then Exit Sub
strAdd2 = Selection.Address
strID2 = Selection.ID
End Sub

5. And finally put this in to sheet1 class, Worksheet_SelectionChange
event procedu

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Len(Target.ID) = 0 Then Exit Sub
If IsOdd(scCount) Then
strAdd2 = Target.Address
strID2 = Target.ID
scCount = scCount + 1
Else
strAdd1 = Target.Address
strID1 = Target.ID
scCount = scCount + 1
End If
If strID1 = strID2 And strAdd1 < strAdd2 Then
MsgBox "The cell withID '" & strID1 & "' was dragged from address '"
_
& strAdd1 & "' to address '" & strAdd2 & "'"
End If
End Sub

After putting all above code in appropriate locations, save your
workbook, close it and open again.
Then check by dragging a single used cell in sheet1.
The output I have given is a message box informing the source and
destination address of the dragged cell.
You can used strAdd1 and strAdd2 and addresses of soruce and destination
respectively, in your further code.

Sharad


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Hello Peter,

The 5th code which I gave has small bug. For every alternate drag and
drop it will swap the source and destination address. To correct this,
discard the earlier 5th code I gave and use following instead:-

Sharad

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Len(Target.ID) = 0 Then Exit Sub
If IsOdd(scCount) Then
strAdd2 = Target.Address
strID2 = Target.ID
scCount = scCount + 1
Else
strAdd1 = Target.Address
strID1 = Target.ID
scCount = scCount + 1
End If
If strID1 = strID2 And strAdd1 < strAdd2 Then
If Target.Address = strAdd1 Then
strAdd1 = strAdd2
strAdd2 = Target.Address
End If
MsgBox "The cell withID '" & strID1 & "' was dragged from address '"
_
& strAdd1 & "' to address '" & strAdd2 & "'"
End If
End Sub




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!