[Resolved]Problem with VBA in Excel

[jmcgill]

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

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

[jmcgill]

Does anyone have any suggestions?

[DKenny]

Why are yo using the Worksheet_SelectionChange? IF you are using a combobox then you shoul;d have your code triggered by the _Change event of the combo.

[New2vba]

It is a list generated through data validation.

[DKenny]

OK, that makes a bit more sense - guess I could have looked at the attachment.

You still should not be using the _SelectionChange event for this. You would be better off using the _Change event and only executing the code if the Target cell is in Column "I" which has the Dropdown validation list.

[jmcgill]

The reason I am using _SelectionChange is because i only want it to run through the code when one of the cells is changed (J). If i use _Change it runs through on every cell change.

[DKenny]

If i use _Change it runs through on every cell change.

Not true.

Here's an example of how you can test to see if the cell being changed is in Column I and only continue if that condition is true.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Check if the cell being changed is in Column I
    'If not then exit
    If Target.Column <> 9 Then Exit Sub
    
    'rest of code here
    
End Sub

[jmcgill]

i tried putting in your suggestion and the problem became worse. it is copying every cell when it is changed even with the if target.column statement in the code. have you tried running my code to see what it is doing?

[DKenny]

We need to take several steps back here. I'm a little confused about what the requirement is here. I know you want to copy cells from sheet1 to sheet2 but I have some questions.

You state that you need to copy 4 of the fields, but I have no idea which 4?

You have lots of looping through evey cell in column I and column J. Do you need to copy all rows every time a single row is changed or only the row that was changed?


What is this piece of code supposed to achieve?

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

In this procedure your comment has no relationship to the code, no where do you check the values in A11:C11. What is the intent here?

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

So, right now I have no idea what the real purpose is. If you can give an explaination of what the true requirements are, we will be able to get you the code you really need.

[jmcgill]

i need to copy the 1st 4 cells in sheet one. they only need to copy when the active row is changed. this is my first excel project. i usually deal with Access or VB6. thanks for all the help.

[DKenny]

OK, that's a start. Here's some code that will copy the first 4 cells from the active line on sheet1 to the next available line on sheet2 - but only when the value in column I = "New".
Remove, or comment out all your existing code. Add this event procedure and test the result. I'm sure we will have to tweak this a little, but play with it and come back with your questions/comments We will continue form there.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lSourceRowNum As Long
Dim lDestRowNum As Long
Dim rngCopy As Range
 
    'Check if the cell being changed is in Column I
    If Target.Column = 9 Then
        
        'Has the cell been changed to the value "New"?
        If Target.Value = "New" Then
            
            'Deterime what row we are on
            lSourceRowNum = Target.Row
            
            'Copy the first 4 cells in the current row
            With ActiveSheet
                .Range(.Cells(lSourceRowNum, 1), .Cells(lSourceRowNum, 4)).Copy
            End With
            
            'Determine our Destination Row
            lDestRowNum = Worksheets("Sheet2").Range("A65536").End(xlUp).Row + 1
            
            'Paste to the next row on Sheet2
            With Worksheets("Sheet2")
                .Range(.Cells(lDestRowNum, 1), .Cells(lDestRowNum, 4)).PasteSpecial
            End With
            
            'Clear the clipboard
            Application.CutCopyMode = False
            
        End If
    End If
End Sub

[jmcgill]

That works perfect. Now I need to get all my other stuff back in (changing column F depending on what date is in column E and filling in column J).

Thank you so much.

[DKenny]

No worries, glad to help.

Here are some suggestions

If there is anywhere in the code that you need to make changes to Sheet1 make sure that you Disable Events before you make the changes and reenable that after the change. this will prevent the _Change event from calling itself which can be a very bad thing indeed.

For filling in Column J - you may want to consider using a SELECT CASE statement based on Target.Value. Have a look at the help on SEELCT CASE, and come back with any questions.

[jmcgill]

I have everything working except 1 more thing. I keep overwriting the line on sheet 2. It is not advancing to the next available line.

[DKenny]

Hummm, this piece of code should always give you the next unused cell in Column A. It is working fine on my machine. Are you coyping into Cols A-D on sheet2?

'Determine our Destination Row
            lDestRowNum = Worksheets("Sheet2").Range("A65536").End(xlUp).Row + 1

[jmcgill]

It is asking if I want to replace the contents of the cells. If I choose yes it overwrites, if I choose no it errors and stops.

[DKenny]

Please answer this question
Are you copying into Cols A-D on sheet2?

If the answer is yes then there's something else going on in your code. If the answer is no then change .Range("A65536") so that it references the first column that you are copying into.

Can you post the _Change event macro that you currently have. I need to compare it to my original.

[jmcgill]

I am copying into A - E on sheet 2.

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lSourceRowNum As Long
Dim lDestRowNum As Long
Dim rngCopy As Range
    
    'Check if the cell being changed is in Column I
    If Target.Column = 9 Then
        
        'Has the cell been changed to the value "New"?
        If Target.Value = "New" Then
            
            'Deterime what row we are on
            lSourceRowNum = Target.Row
            
            'Copy the first 4 cells in the current row
            With ActiveSheet
                .Range(.Cells(lSourceRowNum, 1), .Cells(lSourceRowNum, 5)).Copy
            End With
            
            'Determine our Destination Row
            lDestRowNum = Worksheets("Sheet2").Range("A60000").End(xlUp).Row + 1
            
            'Paste to the next row on Sheet2
            With Worksheets("Sheet2")
                .Range(.Cells(lDestRowNum, 1), .Cells(lDestRowNum, 4)).PasteSpecial
            End With
            
            'Clear the clipboard
            Application.CutCopyMode = False
            
        End If
    End If
    
End Sub

[DKenny]

OK, this may seem like a dumb question, but...
Do you have any data in columns B through D on the row(s) that are directly below the last row on sheet2 where you have a value in Column A?

Also, do the following
1/ Write down the last row number used on sheet2.
2/ Insert a breakpoint on the following line

.Range(.Cells(lSourceRowNum, 1), .Cells(lSourceRowNum, 5)).Copy

3/ Add a row in sheet one and make the value in column i = 'New".
4/ when the code pauses, get the value of lDestRowNum from either the imediates or watch windows.

[jmcgill]

I am not sure what happened, but when I put in the breaks and ran the code it worked and has worked ever since. Thank you so much for all the help.