Stuck with VBA

Z

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

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
jim may

jim may

Well-known Member
Joined
Jul 4, 2004
Messages
7,484
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
G

Gold_Ninja

New Member
Joined
Oct 22, 2012
Messages
21
ADVERTISEMENT
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
Andrew Poulsom

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
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
You must log in or register to reply here.

Similar threads

N
  • Solved
Keeping formatting while transferring info from one workbook to another VBA - Excel 2019
Replies
3
Views
212
Anthony47
A
C
  • Question
Serial sequence unique Bills of Lading (BOL) after each printing.
Replies
7
Views
308
Carl_upnorth
C
R
  • Question
Delete from 2 tables at same time
Replies
2
Views
87
Rfriend
R
S
  • Question
User verification-VBA code
Replies
2
Views
147
Sunnygreet
S
N
  • Question
Add Day and Month in "DDD" & "MMM" format
Replies
1
Views
185
bebo021999
B

Forum statistics

Threads
1,195,619
Messages
6,010,736
Members
441,567
Latest member
Flitbee

Share this page

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
Top