Worksheet Change Event

Topic

New Reply

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
	
If Intersect(Range("J3"), Target) Is Nothing Or Intersect(Range("J3"), Target) = "Select a Player from the list" Then
	MsgBox "No Player was selected."
	Exit Sub
End If
	
ActiveSheet.Unprotect
Application.ScreenUpdating = False

Dim amt As Worksheet, wow As Worksheet
Dim w As Long
Dim x As Range

	Set amt = Worksheets("Admin MGR Teams")
	Set wow = Worksheets("WhoOwnsWho")
	
	w = amt.Cells(Rows.Count, 1).End(xlUp).Row
	
	Set x = amt.Range("A2:A" & w)
	x.Copy
		wow.Range("D11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
		
	Set x = amt.Range("B2:P" & w)
	x.Copy
		wow.Range("G11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.ScreenUpdating = True
'ActiveSheet.Protect

End Sub

I’m a little confused.

J3 is a data validation list.

I am trying to use a change event on J3. If the cell changes to “” or “Select a Player from the list”, then I get the expected Msgbox and the sub is exited.

If J3 changes to something else from the list, then I am getting error 91 with the If statement being highlighted. However, the first copy & paste instruction does execute.

If I change the If statement to:

If Range(“J3”) Is Nothing Or Range(“J3”) = “Select a Player from the list” Then

The procedure goes into repeated execution and never ends. What am I missing?

Reply | Quote

Replies

Surely you don’t want a message box each time the user edits another cell than J3?

Change the beginning of the macro like this:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Range("J3"), Target) Is Nothing Then
	Exit Sub
  End If
  If Range("J3") = "Select a Player from the list" Then
	MsgBox "No Player was selected."
	Exit Sub
  End If

  ActiveSheet.Unprotect
  ...

Reply | Quote

Thankyou, I see where I went wrong.

Another one:

Code:

w = wow.Cells(Rows.Count, 4).End(xlUp).Row
	Set x = wow.Range("H11:W" & w)
	y = wow.Range("D7")

I need to look at each row between rows 11 and w, specifically at cells H:W, to ascertain if y exists in the range. If it does, then I need to clear the contents of H:W, if not then delete cells from A:W (move up).

I know that this needs to be a backwards for next loop, but am struggling with the syntax and would appreciate your help.

Reply | Quote

Try

Code:

  Dim r As Long
  For r = w To 11 Step -1
	If wow.Range("H" & r & ":W" & r).Find(What:=y, _
		LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
	  wow.Range("A" & r & ":W" & r).Delete Shift:=xlShiftUp
	Else
	  wow.Range("H" & r & ":W" & r).ClearContents
	End If
  Next r

Reply | Quote

Works perfect, much appreciated!

Reply | Quote

I’m not sure if this is possible, but worth asking.

Code:

	w = wow.Cells(Rows.Count, 4).End(xlUp).Row
	Set x = wow.Range("D14:D" & w)
	
	j = lge.Cells(Rows.Count, 2).End(xlUp).Row
	Set z = lge.Range("B5:B" & j)

For each range in x, I want to find it in z and then return:

range(z.offset(0, 7):z.offset(0, 16))

to:

x.offset(0,10)

as a copy / paste action.

I know that this could be done by adding vlookup formulas on the fly, but would rather avoid that if possible.

Reply | Quote

Sorry, I don’t understand. z is a multi-cell range, so what do you mean by range(z.offset(0, 7):z.offset(0, 16))?

Reply | Quote

Sorry, I want to return the found cell’s offset range of 7:16. Does that make sense?

IOW, for example:

wow.D14 is found in lge.B56. Therefore copy lge.I56:R56, destination wow.N14

Reply | Quote

Does this do what you want?

Code:

  Dim c As Range
  Dim f As Range
  For Each c In x
	Set f = z.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)
	If Not f Is Nothing Then
	  lge.Range(f.Offset(0, 7), f.Offset(0, 16)).Copy Destination:=c.Offset(0, 10)
	End If
  Next c

Reply | Quote

Yes, sort of. f does’nt change, so the first copy/paste is correct, but all subsequest copy/paste actions are based on the first. I can’t see why?

Reply | Quote

I apologize, there’s an error in my code. The line

Set f = z.Find(What:=x.Value, LookIn:=xlValues, LookAt:=xlWhole)

should have been

Set f = z.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)

Reply | Quote

And then it slapped me in the face:

Set f = z.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)

Thanks very much Hans

Reply | Quote

Snap.

Reply | Quote