Question

What I have is a spreadsheet with over 100 tabs with relatively the same format of data, but some sheets have more or less rows than others. I have a sheet named EMP_NUM with all employee numbers and names. I have a Master sheet that I would like all the relative data copied to the Master sheet. The employee numbers listed on sheet EMP_NUM match the names of the 100+ sheets. In the end, I would like each row on the Master sheet to have the first cell to be the employee number, then the remaining cells in the row be the data collected from all the other sheets.

The employee# sheet's data that needs to be copied starts at A4 and ends at TX where X equals the greatest row number in columnA that still has a value.

I was thinking of using the data in the EMP_NUM to be called in the procedure to find the correct sheet for copying the data since they would match, but also to use as the first cell in the row.

Once I am done, I can add my formulas to calculate the data. It's been over 6 years since I dabbled a teeny tiny bit in VB in Excel, and I'm not sure what to do. Thank you all for your help!! Please let me know if I need to clear anything up.

**ADDED**

I would imagine the first step is to find the first sheet to copy data from. To find the first sheet the function should go to the EMP_NUM sheet and see what the first number is, that number relates exactly to the name of the sheet we want. That can be intEmpNum

Then on the corresponding sheet, I figure out how many rows past row 4 has data. These rows would be the range to copy. Copy this range at the first available row on sheet Master starting at Column B leaving column A blank for now. Column A is for the intEmpNum for all rows that have data in Column B but not Column A.

Then find the next employee number on EMP_NUM and repeat the process until there are no more employee numbers in column A on sheet Emp_NUM

This is what I have so far -

Sub Button1_Click()    
Dim intEmpNum As Integer 'employee number
    Dim strEmpCell As String 'row that employee number is in 
    strEmpCell = 1
    Do Until Sheets("EMP_NUM").Range("A" + strEmpCell).Value = 0
        intEmpNum = Sheets("EMP_NUM").Range("A" + strEmpCell).Value
        strEmpCell = strEmpCell + 1
    Loop
        MsgBox ("The value was not found!")
End Sub
Was it helpful?

Solution

I think you have the right idea regarding the code that you have so far. But I would consider using dynamic range names instead to set the list of employee numbers. So you might have as a rangename.

Create a new rangenamed called "EmployeeNum" with the following formula

=OFFSET("EMP_NUM!$A1",0,0,COUNTA("EMP_NUM!$A:$A"),1)

This makes the loop code a little easier to deal with

Sub getEmployeeData()
    Dim rCell As Range
    Dim dblPasteRow As Double

    'Start pasting in first row

    For Each rCell In Range("EmployeeNum")
        dblPasteRow = dblPasteRow + CopyData(rCell.Value, dblPasteRow)
    Next rCell
End Sub

I am using a function to do the copying. Firstly, it splits the code up into the two small jobs you need. Second, a function can return data so we can let the calling sub know how many rows of data we pasted.

Function CopyData(strEmpNum As String, dblPasteStart As Double) As Double

    Dim wksEmployee As Worksheet
    Dim dblEndRow As Double

    'If there is an error, we are adding 0 rows
    CopyData = 0
    'Error handling - if sheet isn't found
    On Error GoTo Err_NoSheetFound
    'Set a worksheet object to hold the employee data sheet
    Set wksEmployee = Sheets(strEmpNum)
    On Error GoTo 0

    With wksEmployee
        'Find the last row on the worksheet that has data in column A
        dblEndRow = .Range("A4").End(xlDown).Row
        'Copy data from this sheet
        Range(.Range("A4"), .Range("T" & dblEndRow)).Copy
    End With

    'Paste data to master sheet - offset to column B
    Range(Worksheets("MASTER").Range("B" & dblPasteStart), Worksheets("MASTER").Range("U" & dblPasteStart + dblEndRow)).Paste
    'Write employee numbers next to the data
    Range(Worksheets("MASTER").Range("A" & dblPasteStart), Worksheets("MASTER").Range("A" & dblPasteStart + dblRowEnd)).Value = strEmpNum

    'Let the calling sub know how many rows we added
    CopyData = dblEndRow

    Exit Function
'Only runs if an error is found
Err_NoSheetFound:
    Debug.Print "Can't find employee number: " & strEmpNum

End Function

I haven't run the code so there could be some bugs in it. I hope it at least points you in the right direction.

OTHER TIPS

I have recently picked VBA for one time project. Split your work in to smaller tasks.

Here is how to find given NAME on the sheet wn:

Dim wn as String
Dim COLUMN_WHERE_ID_IS as String

COLUMN_WHERE_ID_IS = "B" 
For srow = 1 To Worksheets(wn).Range("B65536").End(xlUp).row
 If (Worksheets(wn).Range(COLUMN_WHERE_ID_IS & srow & ":" & COLUMN_WHERE_ID_IS & srow).Value = NAME) Then
     '' copy stuff to target you have range now
 Exit For
End If
Next srow

Now make a function that would go through all cells and retrieve NAME, then call above subroutine. Then you need to find how to loop through all sheets.

Mind that it is terribly ineffective. From algorithmic point of view you should put all EMP NUM into Set structure and make check if set.contains(_empnum) during going over any of the sheets.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top