Father Goose
Father Goose

Reputation: 87

Excel VBA Copy Paste issue

I am working with Excel VBA Copy Paste. Cell R7 has formula =Max ("C77:AD81").

What I am trying to achieve is if R7 > F7, copy R7 Value to F7 and change the Q7 to = today.

All I'm achieving is R7 changes to max of ("C77:AD81") and the remaining code doesn't work. My code below.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, r As Range, rv As Long


    If Not Intersect(Target, Range("R7")) Is Nothing Then
        Set rng = Intersect(Target, Range("R7"))
        For Each r In rng
            'Change Best Peak Flow and Date Achieved
            Select Case r.Value
            Case Is > ("F7")
            Case Range("R7").Select
            Case Range("R7").Copy
            Case Range("F7").Select
            Case Range("F7").Paste
            Case ("R7") = ("F7")
            Case Range("Q5").Select
            Range("Q5") = Today()
            Application.CutCopyMode = False
            End Select
        Next r
    End If

End Sub

Upvotes: 1

Views: 306

Answers (3)

Father Goose
Father Goose

Reputation: 87

I solved it.
Here is the code I used.

Private Sub Worksheet_Change(ByVal Target As Range)

'Change Best Peak Flow and Date Achieved

If Range("R7").Value > Range("F7").Value Then
    Range("R7").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q5").Select
    Selection.Copy
    Range("K7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End If
End Sub

Upvotes: 1

K.Dᴀᴠɪs
K.Dᴀᴠɪs

Reputation: 10139

So, your rng object is only 1 cell, because you specified 1 target range of R7. With this being said, your For Each...Next statement is redundant.

I also wouldn't even use Select Case at all, but I will leave it in the event you later want to build off of it.

Give this a shot

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ErrHandler    'Important to ensure events are reenabled
    Application.EnableEvents = False

    Dim rng As Range, r As Range, rv As Long
    Set rng = Intersect(Target, Range("R7"))
    If Not rng Is Nothing Then
        'Change Best Peak Flow and Date Achieved
        Select Case True
        Case r.Value > Range("F7").Value
            Range("F7") = Range("R7")
            Range("Q5") = Date
        End Select
    End If

    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    Application.EnableEvents = True
    MsgBox Err.Number & vbNewLine & Err.Description

End Sub

Upvotes: 1

AcsErno
AcsErno

Reputation: 1615

My advice is not to use .select. You can program everything without a single .select. Recording and analyzing macros are very good starting point for learning VBA, but sometimes they are way too complicated. I prefer simple solutions so give this a try:

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("F7") <> Range("R7") Then
    Range("F7") = Range("R7")
    Range("Q5") = Date
End If
End Sub

Upvotes: 1

Related Questions