2

I suspect this isn't all that complicated, but I'm not having much luck finding the right terms to Google... so I came to the experts!

So I'm trying to implement an Worksheet_Change event. It's exceedingly simple, I basically just want to do the following:

If Value in Column C changes, and Value in D (in that row) has a specific formatting (NumberFormat = "$ 0.00") then Column E (in that row) is the product of those two values. Easy. Practically speaking, I just want the VBA equivalent of using a formula in the E column. This the code I'm using:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 And Target.Value <> "" Then
    If Target.Offset(0, 1).NumberFormat = "$ 0.00" Then
        Target.Offset(0, 2).Value = Target.Value * Target.Offset(0, 1).Value
        End If
        End If   
end sub        

My problem is popping up when I try to paste in multiple values into multiple rows of the c column. i.e. I'm copying a column of data (> 1 row) into C and I get a type mismatch error. I'll make the gigantic leap that it's not dealing with this well because "target" is intended to be a single cell as opposed to a group. I'm hoping there's a simple way to deal with this that doesn't involve some crazy loop every time a cell changes on the sheet or something.

Thanks in advance!

Community
  • 1
  • 1
Finch042
  • 307
  • 3
  • 9
  • 18

2 Answers2

2

Is this what you are trying?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(3)) Is Nothing Then
        For Each aCell In Target
            If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
                aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
            End If
        Next
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

You might also want to read THIS?

Though you wanted to trap only Col C Paste but here is one more scenario where user pastes in multiple columns (One of them being Col C)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False


    If Not Intersect(Target, Columns(3)) Is Nothing Then
        If Not Target.Columns.Count > 1 Then
            For Each aCell In Target
                If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
                    aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
                End If
            Next
        Else
            MsgBox "Please paste in 1 Column"
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub
Community
  • 1
  • 1
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • Mostly right. However, if the Target extends beyond column C, this will cause something horrible to happen. I think you need to check that the target is ONLY column C, and your current condition doesn't do that. Like the error labels, and the `Resume Letscontinue` program flow. Enough for an upvote. – Floris Apr 21 '13 at 17:59
  • That's exactly the sort of solution I was looking for. I'll need to tweak it a bit, but you just saved me a great deal of mental anguish trying to sort it out myself. Thanks! – Finch042 Apr 21 '13 at 18:03
  • 1
    @Floris: Updated the code with the scenario that you mentioned – Siddharth Rout Apr 21 '13 at 18:03
  • the solution I had in mind sets a new range to the intersection of Target and Col C, then operates on those cells. It can be generalized to an arbitrary "good" range, not just a single column. – Floris Apr 21 '13 at 19:32
  • @Floris: If you wish, you may post your version :) I have no issues :) – Siddharth Rout Apr 21 '13 at 19:36
0

In the spirit of completeness and collaboration, I am posting here a variation of Siddharth Rout's method; the difference is that this does not rely on "cells to act on" all being in one column. This makes it a little bit cleaner, and easier to adapt to other scenarios.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim onlyThese As Range   ' collection of ranges that, if changed, trigger some action
    Dim cellsToUse As Range  ' cells that are both in "Target" and in "onlyThese"

    On Error GoTo Whoa

    Application.EnableEvents = False

    Set onlyThese = Range("C:C") ' in this instance, but could be anything - even a union of ranges
    Set cellsToUse = Intersect(onlyThese, Target)
    If cellsToUse Is Nothing Then GoTo Letscontinue

    ' loop over cells that were changed, and of interest:
    For Each aCell In cellsToUse
        If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
            aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
        End If
    Next

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub
Floris
  • 45,857
  • 6
  • 70
  • 122