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
------------------------------------------------------------------------
jaymcgill's Profile: http://www.excelforum.com/member.php...o&userid=33799
View this thread: http://www.excelforum.com/showthread...hreadid=535700