Sending an email if Current User matches cell values

[Catsonheat]

Hi everyone,

I am trying to design a macro which will detect the current user (based on their login) and if that user matches the user name in a cell it will email the contents of other cells to that users email address. It's purpose is to be a forgotten your password style event on a login screen.

For example I have a list of usernames in Cell F8 with that users email address in E8 and their password in H8 with a user below that one in F9 and so on.

Can anyone shed some light on how i would get this to work? See my code so far:

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Dim RowH As Integer
Dim Counter As Integer
Dim WinUser As Variant
Dim mailAddress As String
Dim Ash As Worksheet
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

RowH = 1
Counter = 0

ThisWorkbook.Application.Iteration = True
ThisWorkbook.Application.MaxIterations = 1
ThisWorkbook.Application.MaxChange = 0.001

'Capture the BRID of the person logged into the machine
WinUser = Environ("UserName")

'Check if user on list and increase Counter by 1 if True
Do Until Sheets("Login").Cells(RowH, 6) = "NO USER"

RowH = RowH + 1

    If Sheets("Login").Cells(RowH, 6).Value = WinUser Then
    Counter = Counter + 1
    End If
Loop

Sheets("Interface").Activate
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
mailAddress = ""
On Error Resume Next

          On Error GoTo 0

If mailAddress <> "" Then

With Ash.AutoFilter.Range
On Error Resume Next

Set rng = .SpecialCells(xlCellTypeVisible)

On Error GoTo 0
End With

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail

.to = mailAddress
.Subject = "Test mail"
.Display  'Or use Send

End With
On Error GoTo 0

Set OutMail = Nothing

End If

cleanup:

Set OutApp = Nothing
Application.ScreenUpdating = True

Sheets("Interface").Activate
If Counter = 0 Then

MsgBox "You do not have a profile.", , "Notification"

End If

Application.ScreenUpdating = False

End Sub

At present when the counter = 1 line is removed then the macro runs and returns the message you have no profile. when it is added back in the macro does nothing as I cant get the counter = to to trigger sending the email and how to get it to refer to the relevant cells as mentioned above.

Many thanks in advance!