-1

This is my excel sheet:Excel Sheet Screenshot

So the data you see from A2 till H21 is pasted by the customer. What I would like to do is, once the customer paste these data the following should happen:

When ever B is equal to "Brunch" and H is equal to 0, REPLACE H by J3

so instead of the 0 we will have the value/data existing in J3

This should work/done automatically every time the customer paste the data from A2 till H21

I really appreciate any help and hope its clear!

Thanks a lot

  • How are expecting to do this? I suspect VBA would be a more appropriate route but not sure if that's an option? Formulas in **H** wont work as user will over write them every time they paste in the sheet – Zac Mar 23 '18 at 11:18
  • yes that is true Zac that is why i was baffled, any solution would do! VBA would work fine for me as well however I have no idea how to accomplish that in VBA – Jane Machbath Mar 23 '18 at 11:20
  • Alternately, you could have a second sheet in the workbook which takes the values from column **A** to **G** and then have a formula in **H** to work out what needs to be in it – Zac Mar 23 '18 at 11:20
  • @Zac that would not be user friendly for the customer as they will expect to paste the data and everything done automatically. having them paste in one sheet and then look at another sheet for result is misleading – Jane Machbath Mar 23 '18 at 11:27

2 Answers2

0

In a standard code module something like as follows. You could look at tying to an event or simply running from a button push.

Option Explicit

Sub AddPrice()

    Dim wb As Workbook
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet2") 'change as appropriate

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim filterRange As Range
    Set filterRange = ws.Range("$A$1:$H$" & lastRow)

    If lastRow = 1 Then Exit Sub

    With filterRange
       .AutoFilter
       .AutoFilter Field:=2, Criteria1:="Brunch"
       .AutoFilter Field:=8, Criteria1:="0"
    End With

    Dim currArea As Range
    Dim currRow As Range

    For Each currArea In filterRange.SpecialCells(xlCellTypeVisible).Areas
         For Each currRow In currArea.Rows
             If currRow.Row > 1 Then currRow.Cells(1, filterRange.Columns.Count) = ws.Range("J3")
         Next currRow
    Next currArea

    filterRange.AutoFilter

    Application.ScreenUpdating = True

End Sub

And in code pane for sheet 2 (in this example put)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

     Application.EnableEvents = False

    If Not Intersect(Target, Range("A1:H" & UsedRange.Rows.Count)) Is Nothing Then

        AddPrice

    End If

    Application.EnableEvents =True

End Sub

Reference:

Automatically Run Macro When Data Is Pasted VBA

Code pane sheet 2:

Sheet2 code

Standard module code:

Module code

QHarr
  • 83,427
  • 12
  • 54
  • 101
0

Sorry got side tracked but below is slightly different approach from QHarr:

Copy the below code in your worksheet code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column < 8 Then
        Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet8")
        Dim iLR As Long: iLR = oWS.Cells(oWS.Rows.count, "H").End(xlUp).Row
        Dim rHCol As Range: Set rHCol = oWS.Range("H2:H" & iLR)
        Dim rCurRange As Range

        With oWS
            For Each rCurRange In rHCol
                If (LCase(Trim(.Range("B" & rCurRange.Row).Value)) = "brunch") And (CInt(rCurRange.Value) = 0) Then
                    rCurRange.Value = .Range("J3")
                End If
            Next
        End With
    End If

End Sub
Zac
  • 1,924
  • 1
  • 8
  • 21
  • Opss, don't forget to change the sheet name – Zac Mar 23 '18 at 12:17
  • overflow error on line " If (LCase(Trim(.Range("B" & rCurRange.Row).Value)) = "brunch") And (CInt(rCurRange.Value) = 0) Then rCurRange.Value = .Range("J3")" – Jane Machbath Mar 23 '18 at 13:00
  • Hmmm. works for me. But as you have the answer from @QHarr, I wont investigate. Good luck – Zac Mar 23 '18 at 13:14