Target.Count > 1

Question

On a sheet - there are three columns

Duration, Value, Type of value (either Decimal or percentage)

Users will not be allowed to change Duration, but will be able to change Value and Type of value.  I'm not worried about controlling this.

What I would like to have available is the ability of the user to cut and paste Value(s) and/or Type(s) over multiple cells and have it modify the "copied cells" correctly

My code is found below - but if there is a better way I'll switch (Values found in column C and Type in column D)

Obviously the

If Target.Count > 1  Then Exit Sub

needs to change and not sure if I should be using Worksheet_Change or Worksheet_SelectionChange.

Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Target.Count > 1 Then Exit Sub

    If Target.Column = 3 Then

        If Target.Value < 1 Then

            Target.NumberFormat = "0.00%"

            Target.Offset(0, 1) = "Percentage"

        Else

            Target.NumberFormat = "0.00"

            Target.Offset(0, 1) = "Dollar"

        End If

    End If

    If Target.Column = 4 Then

        If Target.Offset(0, -1) = 0 Then

            Target = "Percent"

        Else

            If Left(Target.Value, 1) = "D" Then

                If Target.Offset(0, -1) < 1 Then Target.Offset(0, -1) = Target.Offset(0, -1) * 100

                Target.Offset(0, -1).NumberFormat = "0.00"

            Else

                If Target.Offset(0, -1) >= 1 Then Target.Offset(0, -1) = Target.Offset(0, -1) * 0.01

                Target.Offset(0, -1).NumberFormat = "0.00%"

            End If

        End If

    End If

Application.EnableEvents = True

End Sub

Since posting the original question I've come up with the following

Sub Worksheet_Change(ByVal Target As Range)

'Exit Sub

Dim SaveArray() As Variant

Dim Cell As Range

Dim Counter As Long

Application.EnableEvents = False

ReDim SaveArray(1 To Target.Cells.Count, 1 To 3)

If Target.Count > 1 Then

    With Worksheets("Sheet1")

        For Each Cell In Target.Cells

            Counter = Counter + 1

            If Left(Cell.Value, 1) = "P" Then

                SaveArray(Counter, 3) = Cell.Offset(0, -1) * 0.01

            End If

        Next

        Worksheets("Sheet1").Range("D65536").End(xlUp).Offset(1).Resize(Counter, 3).Value = SaveArray

    End With

End If

Application.EnableEvents = True

End Sub

Answer 1

If you want to manage multiple cells in the Change event, cut off all unused cells and use a FOR EACH loop to get each cell from the Target.

Andreas.

Sub Worksheet_Change(ByVal Target As Range)

  Dim R As Range

  'Act only in the used range of this sheet

  Set Target = Intersect(Target, Target.Parent.UsedRange)

  'Finish if out of this range

  If Target Is Nothing Then Exit Sub

  Application.EnableEvents = False

  'Visit each cell

  For Each R In Target

    Select Case R.Column

      Case 3

        If R.Value < 1 Then

          R.NumberFormat = "0.00%"

          R.Offset(0, 1) = "Percentage"

        Else

          R.NumberFormat = "0.00"

          R.Offset(0, 1) = "Dollar"

        End If

      Case 4

        If R.Offset(0, -1) = 0 Then

          R = "Percent"

        Else

          If Left(R.Value, 1) = "D" Then

            If R.Offset(0, -1) < 1 Then R.Offset(0, -1) = R.Offset(0, -1) * 100

            R.Offset(0, -1).NumberFormat = "0.00"

          Else

            If R.Offset(0, -1) >= 1 Then R.Offset(0, -1) = R.Offset(0, -1) * 0.01

            R.Offset(0, -1).NumberFormat = "0.00%"

          End If

        End If

    End Select

  Next

  Application.EnableEvents = True

End Sub

Answer 2

Thank you,

FYI  - (and this was my fault)

R="Percent"

sb

R= "Percentage"