copy to another spreadsheet based on criteria

[Yabba]

Hello all, I am new to Mr. Excel.

I am hoping someone can help me with this. I have 2 worksheets, and need to do a few things...

1. Check the sheet "Payroll" for an employee name based on what name is currently listed on the spreadsheet "Staff Bill" (cell b44)
2. If this employee is already listed in "Payroll" (range a3:a25), copy the amount listed in a cell on "Staff Bill" (cell g44) to a cell on "Payroll" (column v) in the employee's row
3. If the employee is not listed on "Payroll", add them to the "Name" column on "Payroll" and then copy over the amount listed "Staff Bill"


Any help would be appreciated.

 

[sijpie]

OK, you will need to do this with a macro, as with formulas you cannot change other cells.

Let me know if you are happy doing that, and what macro experience you have.

 

[Yabba]

Thanks for the reply. It's been several years since I did any programming in vba, in fact the current version at the time was Access 97... Having said that, I still remember enough to muddle through and still have my old books, so I should be able to find my way through. I appreciate the help, so I'm willing if you are

As a side note, I have 2 other subs going on with these sheets, so if possible, I would like to attach this to a cmd_click that I already have performing a separate task. It very basic, the procedure is simply looking at a cell in "Staff Bill", using that employee name to verify if they already have their own worksheet, and if they do, copy their staff bill to that sheet. If they don't already have a sheet, it creates one for them and then copies their bill. Here is the sub... try not to laugh at the code....

Sub cmdupdate_click()

Sheets("Staff Bill").Range("A1:i44").Copy

If (SheetExists(Sheets("Staff Bill").Range("b44").Value) = True) Then
Worksheets(Sheets("Staff Bill").Range("b44").Value).Activate
ActiveSheet.Range("B65536").End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=8
Selection.PasteSpecial Paste:=xlValues
Else
Sheets.Add(after:=Worksheets("Staff Bill")).Name = Sheets("Staff Bill").Range("b44").Value
ActiveSheet.Range("B65536").End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlFormats
Selection.PasteSpecial Paste:=8
Selection.PasteSpecial Paste:=xlValues
End If

End Sub

Function SheetExists(SheetName As String) As Boolean
SheetExists = False
On Error GoTo NoSuchSheet

If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If

NoSuchSheet:
End Function

 

[sijpie]

While I potter about, please test this code as a replacement for the code you have. It is slightly neater and more efficient...

If you paste code, please put it between code markers [ code] your code here [/code]
(but leave away the space between the first bracket and the word 'code')

Option Explicit


Sub cmdupdate_click()
Dim wsSB As Worksheet, sOut As String


    Set wsSB = Sheets("Staff Bill")
    sOut = wsSB.Range("b44").Value


    If Not SheetExists(sOut) Then
        Worksheets.Add(after:=Worksheets("Staff Bill")).Name = sOut
    End If
    Worksheets(sOut).Activate
    Range("B65536").End(xlUp).Offset(1, -1).Select
    wsSB.Range("A1:I44").Copy
    With Selection
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .PasteSpecial Paste:=xlPasteColumnWidths
    End With
    Set wsSB = Nothing
End Sub


Function SheetExists(SheetName As String) As Boolean
    Dim wsS As Worksheet
    
    SheetExists = False
    On Error Resume Next
    Set wsS = Worksheets(SheetName)
    On Error GoTo 0
    If Not wsS Is Nothing Then
        SheetExists = True
    End If


End Function

 

[Yabba]

Thanks very much. It threw an error trying to select the range("b65536").end(xlup).... but after I included the entire path it works great. I like what you did by declaring the sOut range... very smart. Now as to my original issue, any ideas?

 

[sijpie]

Ahh impatient, eeh? I said you needed to check that out while I would do the request...

OK, replace all the code with this (I have also amended the other code somewhat)

Option Explicit


Sub cmdupdate_click()
    Dim wsSB As Worksheet, sOut As String


    Application.ScreenUpdating = False  ' Stop screen flicker, speed up process
    Set wsSB = Sheets("Staff Bill")
    sOut = wsSB.Range("b44").Value
    CopyEmployeeStaffBill sOut, wsSB    ' call sub to copy data to empl sheet
    wsSB.Activate
    CopyEmployeePayroll sOut, wsSB      ' call sub to transfer salary to payroll
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    Set wsSB = Nothing
End Sub



Sub CopyEmployeeStaffBill(sname As String, wsSB As Worksheet)
     
    If Not SheetExists(sname) Then
        Worksheets.Add(After:=wsSB).Name = sname
    End If
    Worksheets(sname).Activate
    Range("B65536").End(xlUp).Offset(1, -1).Select
    wsSB.Range("A1:I44").Copy
    With Selection
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .PasteSpecial Paste:=xlPasteFormats
    End With
    Range("B65536").End(xlUp).Offset(1, -1).Select


End Sub



Sub CopyEmployeePayroll(sname As String, wsSB As Worksheet)
    Dim wsPR As Worksheet, rEmp As Range
    
    Set wsPR = Worksheets("Payroll")
    Set rEmp = wsPR.Columns(1).Find(sname, _
                    After:=Cells(1, 1), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)


        If rEmp Is Nothing Then
            Set rEmp = wsPR.Cells(wsPR.Rows.Count, "A").End(xlUp).Offset(1, 0)
            rEmp = sname
        End If
        rEmp.Offset(0, 21).Value = wsSB.Range("G44").Value
    Set wsPR = Nothing
    Set rEmp = Nothing


End Sub



Function SheetExists(SheetName As String) As Boolean
    Dim wsS As Worksheet
    
    SheetExists = False
    On Error Resume Next
    Set wsS = Worksheets(SheetName)
    On Error GoTo 0
    If Not wsS Is Nothing Then
        SheetExists = True
    End If


End Function

I don't know why you had an issue with the line finding last cell. In the code above I am using two methods. The other is actually more correct, because with later versions of Excel, you could have well over 65000 rows

 

[Yabba]

Not sure what the issue was, didn't seem to be able to step down all the way. Once I added "Worksheets(sOut)" to the front of the range line it ran fine. Could it be because I am running 2007? I'm about to try this new code, will let you know, but thank you very much for all of your help.

 

[Yabba]

Sijpie, I cannot thank you enough. The code works great with 2 small issues... for whatever reason, stepping down to a range was still throwing errors, but once I added the entire path it was fine. 2nd issue is that the information that is sent to the "Payroll" sheet is being pasted below a row designated for "Totals". It makes sense since the code seems to be simply looking for the first empty row from bottom up. Could we change that so that it looks for the first empty row from top down?

 

[Yabba]

Actually, issue resolved. I decided to move the "Totals" row to the top, so now code is perfect. Your coding skills are obviously far superior to my own, but if there is anything that I can ever help you with, just say the word.