Problem with VBA in Excel

[jaymcgill]

I am putting together a spreadsheet for my company. Their are 2 sheets
in the workbook. If "New" is chosen from the combo box in column I then
I am copying 4 of the fields already entered in sheet one to the
corresponding fields on sheet 2. The problem i am having is that it is
copying the data 4 times. I can not figure out why this is happening.
If anyone can tell what is going on I would greatly appreciate it.
Below is the code. File is attached.

Thanks,

Jason

Code:
--------------------
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, targetRange As Range
Dim x As Integer, i As Integer, numofRows As Integer
Set topCel = Range("I2")
Set bottomCel = Range("I65536").End(xlUp)
If topCel.Row > bottomCel.Row Then End ' test if source range is empty
Set sourceRange = Range(topCel, bottomCel)
Set targetRange = Range("J2")
numofRows = sourceRange.Rows.Count
x = 1
For i = 1 To numofRows

If sourceRange(i) = "As Is" Then
targetRange(x) = "No Action Needed"
x = x + 1
End If
If sourceRange(i) = "Group Owned" Then
targetRange(x) = "No Action Needed"
x = x + 1
End If
If sourceRange(i) = "New" Then
targetRange(x) = "Cells Copied to Sheet2"
DidCellsChange
x = x + 1

End If
If sourceRange(i) = "Assign To" Then
targetRange(x) = "Cells Copied to Sheet2"
x = x + 1
End If
If sourceRange(i) = "" Then
targetRange(x) = ""
x = x + 1
End If


Next
Set topCel = Range("E2")
Set bottomCel = Range("E65536").End(xlUp)
If topCel.Row > bottomCel.Row Then End ' test if source range is empty
Set sourceRange = Range(topCel, bottomCel)
Set targetRange = Range("F2")
numofRows = sourceRange.Rows.Count
x = 1
For i = 1 To numofRows

If sourceRange(i) < #11/1/2005# Then
targetRange(x) = "No"
x = x + 1
End If
If sourceRange(i) > #11/1/2005# Then
targetRange(x) = "Yes"
x = x + 1
End If

Next

End Sub
Sub CopyCellsValues()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Cells( _
ActiveCell.Row, 1).Range("A1:E1")
With sourceRange
Set destrange = Sheets("Sheet2").Range("A" _
& Lr).Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub DidCellsChange()
Dim KeyCells As String
' Define which cells should trigger the KeyCellsChanged macro.
KeyCells = "J2:J65000"

' If the Activecell is one of the key cells, call the
' KeyCellsChanged macro.
If Not Application.Intersect(ActiveCell, Range(KeyCells)) _
Is Nothing Then KeyCellsChanged

End Sub

Sub KeyCellsChanged()
Dim Cell As Object
' If the values in A11:C11 are greater than 50...
For Each Cell In Range("I2:I65000")
If Cell = "New" Then
CopyCellsValues

End If
Next Cell

End Sub

--------------------


+-------------------------------------------------------------------+
|Filename: ATM Operator Phase II Worksheet.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4690 |
+-------------------------------------------------------------------+

 

[jaymcgill]

Any suggestions would be greatly appreciated.

 

[Guest]

Based on what I see (being event code on selection change) is your code is
going to call itself recusively. By this I mean the the selction change code
does things that generate a selection change event and the code fires again.
To fix this you want to disable events while the code is running something
like this (best to use an error handler with this kind of code)...

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, targetRange As Range
Dim x As Integer, i As Integer, numofRows As Integer

On Error Goto ErrorHandler
Application.EnableEvents = False
'The rest of your code here

ErrorHandler:
Application.EnableEvents = True
end sub

 

[jaymcgill]

I added the error handler as suggestion and it went from copying 4 times
as it was doing originally to copying about 15 times.

Any other suggestions? This is the first Excel project I have ever had
to do. Most of the stuff I have done is either in Access or VB6.

Thanks,

Jason