Advertisement
YasserKhalil2019

T3807_Application Match In Worksheet Change Event In VBA

Aug 27th, 2019
236
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.44 KB | None | 0 0
  1. https://excel-egy.com/forum/t3807
  2. ---------------------------------
  3.  
  4. Private Sub Worksheet_Change(ByVal Target As Range)
  5. Dim x, sh As Worksheet, c As Range, m As Long
  6.  
  7. Set sh = ThisWorkbook.Worksheets("names_boy_data3")
  8.  
  9. If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then
  10. Application.EnableEvents = False
  11. For Each c In Target.Cells
  12. If Application.WorksheetFunction.CountIf(Range("A11:A3000"), c.Value) > 1 Then MsgBox "Student Is Already There", 64: GoTo Skipper
  13. x = Application.Match(c.Value, sh.Columns(2), 0)
  14.  
  15. If Not IsError(x) Then
  16. If sh.Range("D" & x).Value = "" Then
  17. If Range("A2311").Value = "" Then m = 2311 Else m = Cells(Rows.Count, 1).End(xlUp).Row + 1
  18. Range("A" & m).Value = c.Value
  19. Range("C" & m).Resize(1, 3).Value = sh.Range("C" & x).Resize(1, 3).Value
  20. MsgBox "Student Moved As There Is No National ID", 64
  21. c.Value = ""
  22. Else
  23. Range("C" & c.Row).Resize(1, 3).Value = sh.Range("C" & x).Resize(1, 3).Value
  24. End If
  25. Else
  26. Skipper:
  27. Range("A" & c.Row).Resize(1, 5).Value = ""
  28. End If
  29. Next c
  30. Application.EnableEvents = True
  31. End If
  32. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement