VBA HELP! Two worksheet changes in one macro OR Two seperate worksheet change events

Dremzy

New Member
Joined
Apr 19, 2014
Messages
29
Hi all,

I have a worksheet change macro, which checks the value inputted into CELL E5 (Toy Code), it will then match it to Column B in another sheet and pull back a row of data.

I would like to do this macro AGAIN in the same sheet however checking if CELL H5 has been inputted/field has changed from blank to a value(Toy Name). When I try to create this macro again it says there are duplicate/ambigious workchange events and I can not do this.

The purpose of this code is to search for the data inputted in cell e5/h5 and then pull back the product full information from another sheet into the FRONT/Search sheet.

Is there any way to do this?? I have attached the code for the first
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Intersect(Target, Range("E5")) Is Nothing Then Exit Sub
    Dim foundCode As Range
    Set foundCode = Sheets("DATA").Range("B:B").Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundCode Is Nothing Then
        foundCode.EntireRow.Copy Sheets("SEARCH").Cells(8, 1)
    End If
Range("F8:H8").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=9
    Range("D15").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-18
    Range("A8:E8").Select
    Selection.Cut
    Range("D8").Select
    ActiveSheet.Paste
    Range("A8:C8").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6299648
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("I8:J8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6299648
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("E5").Select
    
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("F:F").ColumnWidth = 38.86
    Rows("15:15").EntireRow.AutoFit
    
'Cells are boxed
  Range("D7:H8").Select
    Range("D8").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("D14:F15").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
Application.ScreenUpdating = True

End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
You can only have one Worksheet_Change event procedure per sheet. However you should be able to combine what you want to do in a single one pretty easily. Just have two IF THEN blocks, i.e.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = Range("E5").Address Then
        ' Put all the code that pertains to cell E5 here
    End If

    If Target.Address = Range("H5").Address Then
        ' Put all the code that pertains to cell H5 here
    End If

End Sub
 
Upvote 0
Thankyou !

Two other questions relating to this (Just so you know the code will be the same for each target it just searches column C:C instead of B:B)

1) If the value that is entered is not found can It be made so a message box appears saying " Toy not found" and then it ends the sub. Currently if an incorrect value is entered, the sub simply ends.

2) Is there a way for the macro to search for an approx match?? For an instance if "Hello & G" is entered in E5.. the macro currently searches for that EXACT value in Sheet Can it instead look for an approx match, so if it finds "Hello & Goodbye", it will pull back that row??

Thanks
 
Upvote 0
Hi Joe4, The code you provided doesn't work as if I copy and paste my original code twice into each of the IF scenarios you provided and simply change the target address, I gt an error that there is a duplicate "foundCode As Range"
 
Upvote 0
Two other questions relating to this (Just so you know the code will be the same for each target it just searches column C:C instead of B:B)
Then you might not need two blocks, maybe just an "OR" clause in your IF statement, i.e.
Code:
If (Target.Address = Range("E5").Address) Or (Target.Address = Range("H5").Address) Then


1) If the value that is entered is not found can It be made so a message box appears saying " Toy not found" and then it ends the sub. Currently if an incorrect value is entered, the sub simply ends.
Once again, IF THEN statement should be key here:
Code:
If .... Then
    MsgBox "Toy not found"
    Exit Sub
End If

2) Is there a way for the macro to search for an approx match?? For an instance if "Hello & G" is entered in E5.. the macro currently searches for that EXACT value in Sheet Can it instead look for an approx match, so if it finds "Hello & Goodbye", it will pull back that row??
Approximate matches can be kind of tricky. I prefer to look for entries that start with a specified string (using the LEFT function), or maybe use the INSTR function to see if a word (or phrase) exists anywhere in the cell.

Hi Joe4, The code you provided doesn't work as if I copy and paste my original code twice into each of the IF scenarios you provided and simply change the target address, I gt an error that there is a duplicate "foundCode As Range"
If you are going to use two separate blocks, you may have to make small edits to your code.
 
Upvote 0
In regards to the OR statement.. That changes the Target address but that does not change the "B:B to C:C". How would I do this? So that when the value of E5 is changed it searches BB and then for H5 it searches Columns C:C??????????? As it is your code above wouldn't work.

I will research the LEFT function in regards to that point. Thanktou!
 
Upvote 0
In regards to the OR statement.. That changes the Target address but that does not change the "B:B to C:C". How would I do this? So that when the value of E5 is changed it searches BB and then for H5 it searches Columns C:C??????????? As it is your code above wouldn't work.
The code I posted is just a very high overview shell to get the point across of how you want to structure this.

To do that you want, you can use more if statements (sense a pattern here?).

So, you could do something like this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.ScreenUpdating = False
    
    If (Target.Address = Range("E5").Address) Or (Target.Address = Range("H5").Address) Then
        Dim searchRange As String
        Dim foundCode As Range
        If Target.Column = 5 Then
            searchRange = "B"
        Else
            searchRange = "C"
        End If
        Set foundCode = Sheets("DATA").Range(searchRange).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
        ...
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,264
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top