View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Sharad Sharad is offline
external usenet poster
 
Posts: 123
Default Drag and Drop Help!

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!