vba find function assistance

jiddings

Board Regular
Joined
Nov 22, 2008
Messages
135
I have a spreadsheet that I need to collect data and copy it to a separate spreadsheet.
The source spreadsheet is configured as follows
Column A: Column B:
Employee: Employee clock #
Department: Department A
Reg Pay: daily hrs Sun - Sat(column B - Column H)
Department: Department B
Reg Pay: daily hrs Sun - Sat(column B - Column H)
Department: Department C
Reg Pay: daily hrs Sun - Sat(column B - Column H)
Employee: Employee clock #
Department: Department A
Reg Pay: daily hrs Sun - Sat(column B - Column H)
Department: Department B
Reg Pay: daily hrs Sun - Sat(column B - Column H)
Department: Department C
Reg Pay: daily hrs Sun - Sat(column B - Column H)

This repeats for approx. 60 employees.

As the employees are a shared resource between departments, not all employees work for each department each week and some work in only one department for a given week. Thus, other department designations will not appear for a given employee and will only appear if the employee works for that department during that week.
I've used the vba find function to locate each employee's clock #. I'm having difficulity with vba to locate Department "B" for each employee and I'm attempting to utilize the find function. Any recommendations on vba code to do this would be appreciated.
 
It depend on how everything is setup and what you want done. In general you will have a main sub that is called by running a macro from Excel. If the sheet references for source and/or target worksheet are to be user selected then you will have a function or input box that prompts the user to select the sheet. Below is an example of how you can prompt the user for all the information that will be passed to the HoursByDept sub. The best way to handle this is with a userform which can be setup to include only the valid sheets and department names but I don't want to get that as it very hard to explain over a text forum. I included some minimal error handling which at the least will prevent some crashes of the macro.
Code:
Sub MainHours()
   
   Dim SourceWS As Worksheet
   Dim TargetWS1 As Worksheet
   Dim TargetWS2 As Worksheet
   Dim dept As String
   Dim answer As String
   Dim Departments(1 To 2) As String
   Dim i As Integer
   
   Departments(1) = "DEPT A"
   Departments(2) = "DEPT B"
   
   dept = ""
   '// ------------------------------------------------------------------------
   '// Department Selection
   On Error Resume Next
   answer = Application.InputBox(Prompt:="Enter Department Name as it appears on the Source Worksheet", _
               Title:="Enter Department", Type:=2)
   On Error GoTo 0
   
   For i = LBound(Departments) To UBound(Departments)
      If UCase(answer) = Departments(i) Then
         dept = Departments(i)
         Exit For
      End If
   Next
   
   If dept = "" Then
      MsgBox "Incorrect Entry Ending Macro"
      Exit Sub
   End If
   '// ------------------------------------------------------------------------
   
   '// ------------------------------------------------------------------------
   '// Sheet Selection
   Set SourceWS = getWorkSheet("Select a Cell in the Source Worksheet")
   Set TargetWS1 = getWorkSheet("Select a Cell in the All Hours Worksheet")
   Set TargetWS2 = getWorkSheet("Select a Cell in the Non-Reg Worksheet")
   
   
   If SourceWS Is Nothing Or TargetWS1 Is Nothing Or TargetWS2 Is Nothing Then
      MsgBox "Invalid Sheet Selection Ending Macro"
      Exit Sub
   End If
   '// ------------------------------------------------------------------------
   '// Call Sub
   HoursByDept dept, SourceWS, TargetWS1, TargetWS2
   
   
End Sub




Function getWorkSheet(UserPrompt As String) As Worksheet


   Set getWorkSheet = Nothing
   
   On Error Resume Next
   Set getWorkSheet = Application.InputBox(Prompt:=UserPrompt, Title:="Select Worksheet", Type:=8).Parent
   On Error GoTo 0


End Function

 
Last edited:
Upvote 0

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Thanks, I'll try to work with it. I was really lost on how to setup passing variables.
The user I'm setting up this for is not sophisticated Excel user. My plan is to set up buttons for the user to click on run the code. No user selection of sheets. I want the most simplistic action for the user and minimal user intervention. I may be back to you, if I decide to go with a user form or have further questions on passing variables. Every time I thought I had the variables set, I got an error. I'm confident I didn't have the correct syntax.
I don't understand how to use:
Set SourceWS = getWorkSheet("Select a Cell in the Source Worksheet")
Set TargetWS1 = getWorkSheet("Select a Cell in the All Hours Worksheet")
Set TargetWS2 = getWorkSheet("Select a Cell in the Non-Reg Worksheet")

In the statement:HoursByDept "DEPT A", Sheets("Source"), Sheets("Dept_A_All"), Sheets("Dept_A_Non-Reg") in the two subs from previous VBA?

I tried Source = "the spreadsheet name & sheet" and that didn't work. I admit I'm a novice with passing variables.
 
Upvote 0
The getWorkSheet is a function to get the a worksheet reference from user input but since you are not doing that you can disregard that.

The main thing to understand is because of how the
HoursByDept works by getting passed variable you have to make sure the right data type is passed. The sub is passed four arguments in a specific order that being; HoursByDept <String>, <Worksheet>,<Worksheet>,<Worksheet>. When calling the sub you can pass the arguments as variable or as constant but they have to be of the correct type.

As an example when passing the department name you could pass either

a string constant i.e. "DEPT A" or a variable i.e.
Dim DeptName as String
DeptName = "DEPT A"

It basically the same with the <Worksheet> arguments you must pass a sheet type object which can be defined by using the Sheet("SHEET_NAME") where "SHEET_NAME" is the constant. You can assign the sheet name to a variable like'

Dim shtName as string
shtName = "Source"
Sheet(shtName) '// Passed to sub

or you can define a worksheet variable

Dim sht as Worksheet
set sht = Sheet("Source")

and then pass sht to the sub

Let me know if that helps. If that's not clear could you post the code that not working so I can see where the issue is and hopefully get a better idea of whats wrong.




 
Upvote 0
Ralajer,
I was able to resolve my passing varibles issue to sub HoursByDept.
However, the sub HoursByDept is still capturing hrs. from the employees that have reg hours from two different departments.

I noticed the code line:
Code:
If InStr(1, DeptRefCell.Offset(k, 1).Value, "DEPT", vbTextCompare) > 0 Then Exit Do

had "DEPT" and I changed that to the variable: dept , however, that had no affect on the result.
I'm wondering if the cell offset may need to change to correct to only one deptartment hrs. ??

Please look at the code and let me know what I should be adjusting to rectify this issue.
 
Upvote 0
"DEPT" should not be a variable it checks for the next occurrence of a department under a single employee.

Is it capturing department A and B hours and copying that to the sheet because that is not what it is doing on my end.

For me when I specify say dept A the sub will copy all the hours of any category worked by every employee who had hours under dept A to one sheet and all the non-regular dept A hours to another.

I am not seeing any of the other department's hours copied. I am working off your originally posted source data.
 
Upvote 0
I'm still putting my mind around the DO loops, however, I have may found what may be something that the code
is doing with the department names. Is the code affected by a limitation of the department name?

I have other department names: 400170-GENERAL, ONLINE-ONLINE SUPPORT, & CATALOG. There may be other department
names that could be utilized which I am not aware of at this time.

To make the source data more generalized for posting, I substituted Dept A for CATALOG and Dept B for ONLINE-ONLINE SUPPORT.
I, of course, also substituted XXXXXXXXXXXX for names next to the numerical 4 digit clock numbers.
Using the source data I posted replace department name Dept A with CATALOG and Dept B with ONLINE-ONLINE SUPPORT. Also you might want to try adding department 400170-GENERAL where there is a second entry for a employee for another department.

With those, I think you will see different results from the code.
My only thought is that the code doesn't "like" these longer department names.
Hopefully, this will be an easy adjustment.
 
Upvote 0
The department names not all beginning with "Dept" would definitely explain the issue. A simple fix is to change the if statement that checks for the next department to look in column A instead of column b and look for the Department label.

If InStr(1, DeptRefCell.Offset(k, 1).Value, "DEPT", vbTextCompare) > 0 Then Exit Do

to

If InStr(1, DeptRefCell.Offset(k, 0).Value, "DEPARTMENT:", vbTextCompare) > 0 Then Exit Do

Let me know if this works. Per you private message the notification timing is same for subscribed threads and private messages.
 
Upvote 0
Ralajer,
Your VBA is working and I thought I could modify it to "fit" it into an existing target worksheet structure column by pasting the source row individual cell values in to the various clock# columns. As it copies source row cell data (7 cells) into the various clock# columns (7 cells each), I need to change the individual cell colors for vacation, holiday, etc. I'm posting again as I think the following statement needs to be changed just to select the cell range:

Code:
DeptRefCell.Offset(k, 1).Resize(1, 7).Copy Destination:=TargetWS1.Cells(outLR, 2)
to:
Code:
DeptRefCell.Offset(k, 1).Resize(1, 7).Select

However, I receive an error using this statement.
What would you recommend?
 
Upvote 0

Forum statistics

Threads
1,224,582
Messages
6,179,670
Members
452,936
Latest member
anamikabhargaw

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