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

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA Find Cell from Date listed, in Columns, Return cell to highlight in color
Replies
7
Views
365
mumps
mumps
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
757
Gajendran Yadhav
G
C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
455
CDaviess
C
K
  • Question
How to shorten vba code without any problems
Replies
1
Views
221
kamranyd
K
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
528
bh24524
B

Forum statistics

Threads
1,221,217
Messages
6,158,589
Members
451,501
Latest member
andysacko

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
Back
Top