VBA Code to reject value in sheet1 if already in sheet2 and if not in sheet 2 move the said value to sheet 3

[WillemS]

Hi All,

I am trying to write a VBA code to perform the task mentioned in the title. Here are the specifics:

In my workbook a mail address came in in the Mail sheet, if the same mail address is already in sheet2 then the said mail address must be moved to sheet3, and if not in sheet 2 it must be moved to sheet1.
The process described above must run automatically as and when a new mail address arrives in the Mail sheet
Any help, please?

 

[offthelip]

You haven't stated where the email addresses in sheet 2 are ( I assumed column A) you haven't stated where you want them in sheets 1 and 3 ( I assumed columns A), you haven't stated where they arrive in the Mail sheet. ( i assumed anywhere) and you haven't stated as to whether the "arrival" triggers the worksheet change event ( I assume it did)
put this code in the worksheet code of the Mail sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
 With Worksheets("sheet2")
 Last2 = .Cells(Rows.Count, "A").End(xlUp).Row
 elist = .Range(.Cells(1, 1), .Cells(Last2, 1))
  fnd = False
   For i = 1 To UBound(elist, 1)
    If Target.Value = elist(i, 1) Then
      fnd = True
      Exit For
    End If
   Next i
  End With
 
  If fnd Then
   With Worksheets("sheet3")
   Last3 = .Cells(Rows.Count, "A").End(xlUp).Row
   .Range(.Cells(Last3 + 1, 1), .Cells(Last3 + 1, 1)) = Target.Value
   End With
  Else
   With Worksheets("sheet1")
   Last1 = .Cells(Rows.Count, "A").End(xlUp).Row
   .Range(.Cells(Last1 + 1, 1), .Cells(Last1 + 1, 1)) = Target.Value
   End With
  End If
 End If
  End Sub

 

[WillemS]

Good day trust you are still well and thank you for your prompt reply and help I really appreciate it. My sincere apology for the lack of details in my request, guess I can link it to the many painkillers after my major operation.

Herewith are the missing details. The email addresses arrive in the Mail sheet via an auto-export from Outlook of which the said refresh every minute into the Mail sheet. The said info populate in the Mail sheet from cell A2 and below as there is a heading in cell A1 on the Mail sheet. The requirement will be as soon as a new email address arrives in cell A2 in the Mail sheet, and or any cell below A2, in the Mail sheet, the code must then look if the email addresses arrived in the Mail sheet, from A2 and or below, are already in sheet2 from cell A2 downwards. If already in Sheet 2, in the specific place already noted, it then must be moved to Sheet3 from cell A2 and below and if not in sheet2 as per the already identified position, it must then move to Sheet1 from cell A2 and below. The whole process must run automatically as and when the email addresses arrive in the Mail sheet from A2 onwards.

Hope this fills some of the gaps on the missing information and that I will hear form you soon
Much apperciated
Thank you
Willem

 

[offthelip]

My Assumptions were more or less correct, there is one modifcation just to check Column A on the mail sheet. I still don't know whether your update will change the workhseet change event. the best way t ofind out is to try it:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And Target.Column = 1 Then
 With Worksheets("sheet2")
 Last2 = .Cells(Rows.Count, "A").End(xlUp).Row
 elist = .Range(.Cells(1, 1), .Cells(Last2, 1))
  fnd = False
   For i = 1 To UBound(elist, 1)
    If Target.Value = elist(i, 1) Then
      fnd = True
      Exit For
    End If
   Next i
  End With
 
  If fnd Then
   With Worksheets("sheet3")
   Last3 = .Cells(Rows.Count, "A").End(xlUp).Row
   .Range(.Cells(Last3 + 1, 1), .Cells(Last3 + 1, 1)) = Target.Value
   End With
  Else
   With Worksheets("sheet1")
   Last1 = .Cells(Rows.Count, "A").End(xlUp).Row
   .Range(.Cells(Last1 + 1, 1), .Cells(Last1 + 1, 1)) = Target.Value
   End With
  End If
 End If
  End Sub

 

[WillemS]

You are very clever, thank you so much for the help, I really appreciate it, It appears that when the email address came into the Mail sheet from the outlook export function, that excel sees it as a link back to outlook and not text. Are there any way that we can overcom this to make it a value, just for that moment it came in, to pass it through and then restore the link again?

 

[offthelip]

That does make it a bit more difficult, tis is because excel doesn't associate a hyperlink directly with a cell, you have to search through all the hyperlinks in a worksheet to fine which hyperlink is the one in the cell you are interested in. I have written a function to do this, so you need to include the Hyperlinkfromcell funtion. So try this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And Target.Column = 1 Then
TV = HyperLinkFromCell(Target)

 With Worksheets("sheet2")
 Last2 = .Cells(Rows.Count, "A").End(xlUp).Row
 elist = .Range(.Cells(1, 1), .Cells(Last2, 1))
  fnd = False
   For i = 1 To UBound(elist, 1)
    If TV = elist(i, 1) Then
      fnd = True
      Exit For
    End If
   Next i
  End With
 
  If fnd Then
   With Worksheets("sheet3")
   Last3 = .Cells(Rows.Count, "A").End(xlUp).Row
   .Range(.Cells(Last3 + 1, 1), .Cells(Last3 + 1, 1)) = TV
   End With
  Else
   With Worksheets("sheet1")
   Last1 = .Cells(Rows.Count, "A").End(xlUp).Row
   .Range(.Cells(Last1 + 1, 1), .Cells(Last1 + 1, 1)) = TV
   End With
  End If
 Else
 
 End If
  End Sub


Public Function HyperLinkFromCell(CellRng As Range) As String
Dim h As Hyperlink
  For Each h In ActiveSheet.Hyperlinks
   tt = h.Range.AddressLocal
   If tt = CellRng.Address Then
    HyperLinkFromCell = h.TextToDisplay
    End If
  Next h
 End Function

 

[WillemS]

Eish, you are a real genius ???, thank you so much . Can we communicate via email if possible as I would like to email my workbook to you to help me to get the 3 different segments of code to flow as one process from when the mail came in until it process it, please?

 

[WillemS]

I use this process to get the subject line, sender name, sender email adr and date&time sent from outlook into excel

Not sure if there is an easier way?
Tx
W

 

[offthelip]

I have never used power query, so I am probably not the right person to answer that question. That is one good reason for using this forum, you have a good chance of getting an expert on the particular area of EXCEL you need help with

 

[WillemS]

Thank you much appreciated. Other than how the mail came in the Mail sheet, can I please send you the 2 portions of code to see if you can combine it to do one process from start to finish, excluding the Mail incoming formatting part, please?