Stuck with VBA

zodiaceuk

Board Regular
Joined
Nov 20, 2011
Messages
103
Hi All,

I'm having some issues with this VBA code, I think I'm missing something, but I can;t work out what.
could someone help me at all please?

The code needs to ask if the person is leaving the company or transferring, then follow a slightly different path for each answer.

Thanks
Z

Code:
[COLOR=#000000][FONT=Helvetica Neue]Sub Leavers()[/FONT][/COLOR][COLOR=#000000][FONT=Helvetica Neue]Dim MSG1 As String[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Dim SrchTerm As String, SrchRng As Range, FindThis As Range[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Set SrchRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Confirm is leaver or transfer[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]MSG1 = MsgBox("Is advisor leaving the business?", vbYesNo, "Click 'No' if advisor is transferring to another department or moving to centre")[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'LEAVER[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]If MSG1 = vbYes Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]SrchTerm = InputBox("Enter Employee ID", "Process Leaver")[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]If Len(SrchTerm) = 0 Then Exit Sub[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Set FindThis = SrchRng.Find(SrchTerm, lookat:=xlContents)[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Handle invalid Employee ID[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]If FindThis Is Nothing Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]  MsgBox SrchTerm & " was not found. Please enter a valid Employee ID", vbInformation, "Error!"[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Exit Sub[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Move advisor to Leavers[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Else[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    With FindThis.EntireRow[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    .Copy Sheets("Leavers").Cells(Rows.Count, "A").End(xlUp)(2)[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    .Delete[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Confirm leave date[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    EnterDate = Format(InputBox("Enter Leave Date (mm/dd/yy)", "DATE"), "mm/dd/yy")[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    If IsDate(EnterDate) Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]      Sheets("Leavers").Cells(Rows.Count, "U").End(xlUp)(2) = EnterDate[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    Else[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Handle invalid date[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]      MsgBox ("Date not entered, please enter manually"), , "DATE ERROR:"[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]  End With[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'TRANSFER[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]If MSG1 = vbNo Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]SrchTerm = InputBox("Enter Employee ID", "Process Leaver")[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]If Len(SrchTerm) = 0 Then Exit Sub[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Set FindThis = SrchRng.Find(SrchTerm, lookat:=xlContents)[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Handle invalid Employee ID[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]If FindThis Is Nothing Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]  MsgBox SrchTerm & " was not found. Please enter a valid Employee ID", vbInformation, "Error!"[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Exit Sub[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Move advisor to Leavers[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]Else[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    With FindThis.EntireRow[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    .Copy Sheets("Leavers").Cells(Rows.Count, "A").End(xlUp)(2)[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    .Delete[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Confirm leave date[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    EnterText = InputBox(Prompt:="Enter Move/Transfer Data)", Title:="Advisor Transferring Data")[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    Sheets("Leavers").Cells(Rows.Count, "U").End(xlUp)(2) = EnterText[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]  End With[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]   [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Open Leavers Template Macro[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]    Application.Run "'WFH Master List.xls'!LeaversTemplate"[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]'Confirm leaver processed[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]   MsgBox "Leaver processed", vbInformation, "Complete"[/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue] [/FONT][/COLOR]
[COLOR=#000000][FONT=Helvetica Neue]End Sub[/FONT][/COLOR]
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Among other things, the Statement Msgbox() returns a small number -- so you should DIM your MSG1 as such: Dim MSG1 as Integer
Hope that helps,
 
Upvote 0
Count your If statements then count your End If statements. They should be the same. They aren't.

Try indenting everything inside an If statement, and further indenting when you have a second If statement inside that, etc. Should make it easy to keep track of everything then.
 
Upvote 0
This will compile:

Code:
Sub Leavers()
    Dim MSG1 As String
    Dim SrchTerm As String, SrchRng As Range, FindThis As Range
    Set SrchRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
'   Confirm is leaver or transfer
    MSG1 = MsgBox("Is advisor leaving the business?", vbYesNo, "Click 'No' if advisor is transferring to another department or moving to centre")
'   LEAVER
    If MSG1 = vbYes Then
        SrchTerm = InputBox("Enter Employee ID", "Process Leaver")
        If Len(SrchTerm) = 0 Then Exit Sub
        Set FindThis = SrchRng.Find(SrchTerm, lookat:=xlContents)
'       Handle invalid Employee ID
        If FindThis Is Nothing Then
            MsgBox SrchTerm & " was not found. Please enter a valid Employee ID", vbInformation, "Error!"
            Exit Sub
'       Move advisor to Leavers
        Else
            With FindThis.EntireRow
                .Copy Sheets("Leavers").Cells(Rows.Count, "A").End(xlUp)(2)
                .Delete
'               Confirm leave date
                EnterDate = Format(InputBox("Enter Leave Date (mm/dd/yy)", "DATE"), "mm/dd/yy")
                If IsDate(EnterDate) Then
                    Sheets("Leavers").Cells(Rows.Count, "U").End(xlUp)(2) = EnterDate
                Else
'                   Handle invalid date
                    MsgBox ("Date not entered, please enter manually"), , "DATE ERROR:"
                End If
            End With
        End If
    End If
'TRANSFER
    If MSG1 = vbNo Then
        SrchTerm = InputBox("Enter Employee ID", "Process Leaver")
        If Len(SrchTerm) = 0 Then Exit Sub
        Set FindThis = SrchRng.Find(SrchTerm, lookat:=xlContents)
'       Handle invalid Employee ID
        If FindThis Is Nothing Then
            MsgBox SrchTerm & " was not found. Please enter a valid Employee ID", vbInformation, "Error!"
            Exit Sub
'           Move advisor to Leavers
        Else
            With FindThis.EntireRow
                .Copy Sheets("Leavers").Cells(Rows.Count, "A").End(xlUp)(2)
                .Delete
'               Confirm leave date
                EnterText = InputBox(Prompt:="Enter Move/Transfer Data)", Title:="Advisor Transferring Data")
                Sheets("Leavers").Cells(Rows.Count, "U").End(xlUp)(2) = EnterText
            End With
        End If
    End If

'Open Leavers Template Macro
    Application.Run "'WFH Master List.xls'!LeaversTemplate"
'Confirm leaver processed
   MsgBox "Leaver processed", vbInformation, "Complete"
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

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