I am new to VBA and am having some difficulty using If statements in a Macro I am trying to write. Every month I receive a report in Excel that lists which employees at our company performed certain tasks. The Macro I'm writing is meant to copy and paste the data for each employee under their name in a master workbook.
The problem I'm running into is defining the range that I need to copy. As you'll see in the code, the employees are listed in column B. I start by searching for the employee in column B. If they don't exist, the macro copies and pastes (none) under their name in the master workbook. If it finds their name, it sets the row below their name as a first variable.
Here is where I run into a problem. The next step is to find the next employee listed, and set the row above as the second variable. Then I use the first and second variables to copy and paste that range of rows. I'm using an If statement to cycle through and find the next employee listed. However, my nested If statement is ending after my second Else if statement. Does anyone know a way I could write this better? I tried using Select Case statements but couldn't get the syntax right.
Sub EmployeeActivity()
Dim Employee1 As Integer, Employee2 As Integer, Employee3 As Integer, Employee4 As Integer
Dim EmployeeRange As Range, rngSelectFind As Range, rngPasteFind As Range
Windows("Activities Report.xlsm").Activate
Set rngSelectFind = Columns("B:B").Find(What:="Employee 1", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee1 = rngSelectFind.Row + 1
ElseIf rngSelectFind Is Nothing Then
Set rngSelectFind = Columns("B:B").Find(What:="(none)", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Consultant3 = rngSelectFind.Row
End If
Set rngSelectFind = Columns("B:B").Find(What:="Employee 2", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee2 = rngSelectFind.Row - 1
ElseIf rngSelectFind Is Nothing Then
Set rngSelectFind = Columns("B:B").Find(What:="Employee 3", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee2 = rngSelectFind.Row - 1
End If
ElseIf rngSelectFind Is Nothing Then
Set rngSelectFind = Columns("B:B").Find(What:="(none)", After:=Range("B1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee2 = rngSelectFind.Row - 1
End If
End If
If Employee1 > 0 And Employee2 > 0 Then
Set EmployeeRange = Range(Cells(Employee1, 2), Cells(Employee2, 7))
ElseIf Employee3 > 0 Then
Set EmployeeRange = Range(Cells(Employee3, 2), Cells(Employee3, 7))
End If
EmployeeRange.Select
Selection.Copy
Windows("Monthly Activity Report.xlsm").Activate
Sheets("April '13").Activate
Set rngPasteFind = Columns("A:A").Find(What:="Employee Activities", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngPasteFind Is Nothing Then
Employee4 = rngPasteFind.Row + 1
End If
Range(Cells(Employee4, 1), Cells(Employee4, 6)).Select
Selection.Insert (xlShiftDown)
End Sub
Thank you in advance for any help. Please let me know if I can provide additional context.
Few things that I noticed.
Please do not use .Activate
and Selection
. Directly work with the object. You might want to see THIS
If you are using .Find
then cater for instances when you won't find a match. You have done that at several places but then missed at some.
Do not declare Employee1
, Employee2
etc as Integer
. In Excel 2007+, that can give you an error as Excel 2007+ supports 1048576 rows. use Long
Instead.
I am not sure why are you copying the range EmployeeRange
when you do not intend to paste it anywhere? I see that you are declaring a Paste
Range though...
See this code. Is this what you are trying? ( UNTESTED )
Sub EmployeeActivity()
Dim Employee1 As Long, Employee2 As Long, Employee3 As Long, Employee4 As Long
Dim EmployeeRange As Range, rngSelectFind As Range, rngPasteFind As Range
Dim wb As Workbook, ws As Worksheet
Dim wb1 As Workbook, ws1 As Workbook
'~~> Change path as applicable
Set wb = Workbooks.Open("C:\Activities Report.xlsm")
'~~> Change this to the relevant sheet
Set ws = wb.Sheets("Sheet1")
'~~> Change path as applicable
Set wb1 = Workbooks.Open("C:\Monthly Activity Report.xlsm")
Set ws1 = wb.Sheets("April '13")
With ws
Set rngSelectFind = .Columns("B:B").Find(What:="Employee 1", _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee1 = rngSelectFind.Row + 1
Else
Set rngSelectFind = .Columns("B:B").Find(What:="(none)", _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Consultant3 = rngSelectFind.Row
End If
End If
Set rngSelectFind = Nothing
Set rngSelectFind = .Columns("B:B").Find(What:="Employee 2", _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee2 = rngSelectFind.Row - 1
Else
Set rngSelectFind = .Columns("B:B").Find(What:="Employee 3", _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee2 = rngSelectFind.Row - 1
Else
Set rngSelectFind = .Columns("B:B").Find(What:="(none)", _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not rngSelectFind Is Nothing Then
Employee2 = rngSelectFind.Row - 1
End If
End If
End If
If Employee1 > 0 And Employee2 > 0 Then
Set EmployeeRange = .Range(.Cells(Employee1, 2), _
.Cells(Employee2, 7))
ElseIf Employee3 > 0 Then
Set EmployeeRange = .Range(.Cells(Employee3, 2), _
.Cells(Employee3, 7))
End If
End With
'~~> I am not sure why are you copying this range???
If Not EmployeeRange Is Nothing Then EmployeeRange.Copy
With ws1
Set rngPasteFind = .Columns("A:A").Find(What:="Employee Activities", _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not rngPasteFind Is Nothing Then
Employee4 = rngPasteFind.Row + 1
.Range(.Cells(Employee4, 1), .Cells(Employee4, 6)).Insert (xlShiftDown)
End If
End With
End Sub
TIP : You can create a common .Find
function which can accept parameters. That ways you can drastically reduce your above code ;)
EDIT
See this example ( UNTESTED ) which demonstrates the above tip. This way you do not need to use .Find
again and again in the code.
Sub EmployeeActivity()
Dim Employee1 As Long, Employee2 As Long
Dim Employee3 As Long, Employee4 As Long
Dim EmployeeRange As Range, rngSelectFind As Range, rngPasteFind As Range
Dim wb As Workbook, ws As Worksheet
Dim wb1 As Workbook, ws1 As Workbook
'~~> Change path as applicable
Set wb = Workbooks.Open("C:\Activities Report.xlsm")
'~~> Change this to the relevant sheet
Set ws = wb.Sheets("Sheet1")
'~~> Change path as applicable
Set wb1 = Workbooks.Open("C:\Monthly Activity Report.xlsm")
Set ws1 = wb.Sheets("April '13")
With ws
Employee1 = GetRow(ws, 2, "Employee 1")
If Employee1 <> 0 Then
Employee1 = Employee1 + 1
Else
Consultant3 = GetRow(ws, 2, "(none)")
End If
'
'And So on
'
End Sub
Function GetRow(wks As Worksheet, ColNo As Long, SearchString As String) As Long
Dim rng As Range
Set rng = wks.Columns(ColNo).Find(What:=SearchString, _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If rng Is Nothing Then
GetRow = 0
Else
GetRow = rng.Row
End If
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.