Results 1 to 4 of 4
  1. #1
    Join Date
    May 2005
    Location
    Georgia
    Posts
    3

    Unanswered: Problem with VBA in Excel

    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


    visual basic 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
    Attached Files Attached Files

  2. #2
    Join Date
    May 2005
    Location
    Georgia
    Posts
    3
    Does anyone have any suggestions?

  3. #3
    Join Date
    Oct 2003
    Posts
    1,091
    Just note on posting. It works best if you use the code tags for VBA code:. Makes it easier to read. For instance, use the following (without spaces between)

    [ code ]
    Sub MyTest()
    Dim i as Long
    Range("A1").Select
    End Sub
    [/ code ]

    will look like this

    Code:
    Sub MyTest()
       Dim i as Long
       Range("A1").Select
    End Sub
    old, slow, and confused
    but at least I'm inconsistent!

    Rich
    (retired Excel 2003 user, 3/28/2008)

    How to ask a question on forums

  4. #4
    Join Date
    Feb 2006
    Posts
    113
    Jay,

    From reading your description, what you are wanting to do should be simple.

    Just a galance at the code suggests the code is not simple.

    Maybe others are like me and haven't tried to understand the code because it doesn't look simple.

    A thought, though, that might help. You are wanting to copy 4 fields and the data is being copied 4 times. Sounds like what would happen if the code is itself triggering the event that causes it to run - if that makes sense!

    This is avoided by entering a line near the start of the event code,
    Application.EnableEvents = FALSE

    And then, right at the end of the code,
    Application.EnableEvents = TRUE

    Maybe that will help.

    If you're still stuck, try simplifying your code. And if still stuck, please post again. Try to make it simple for people to help you. Or isolate the particular bit that you are having trouble with and ask about it.

    I guess you know that you can single step through code using F8 in the VBA editor? If not, learn a little about debugging within the VBA editor.

    HTH,
    Fazza

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •