VBA code help with mod

[Ron Abba]

Good evening,
New to VBA and looking to mod some code to preform an additional step.

Private Sub commandbutton2_click()
ActiveSheet.Unprotect "national"
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim c1 As Range, c2 As Range, c4 As Range, c5 As Range, wk As String, x As Integer
wk = "WEEK " & Worksheets(1).Range("N2")
                For Each cell In Sheets(1).Range("R2", Sheets(1).Range("IV2").End(xlToLeft))
    If cell <> "" Then
        TotalEmployees = TotalEmployees + 1
    End If
Next cell
If TotalEmployees = 2 Then TotalEmployees = 1
If TotalEmployees = 3 Then TotalEmployees = 3
If TotalEmployees = 4 Then TotalEmployees = 2
For x = 18 To 21 'names of installers
Dim cells As Range
Set c1 = Worksheets(wk).Range("C5:I5").Find(Worksheets(1).Range("I2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'searches dates
Set c2 = Worksheets(wk).Range("B6:B37").Find(What:=Worksheets(1).cells(2, x), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'searches item list
Set c3 = Sheet1.Range("B5, F5, J5")
Set c4 = Worksheets("Paysheets").Range("c6:c12").Find(Worksheets(1).Range("I2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False)
Set c5 = Worksheets("Paysheets").Range("D2,D57,D111,D165,D219").Find(What:=Worksheets(1).cells(2, x), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'Range("D2,D57,D111,D165,D219") names
    If Worksheets("PAY CALCULATOR").cells(2, x) <> "" Then
        If Worksheets(wk).cells(c2.Row, c1.Column) <> "" Then
            ans = MsgBox("$" & Worksheets(1).cells(62, x) & " + " & "$" & Worksheets(wk).cells(c2.Row, c1.Column) & "  = " & "$" & _
                Worksheets(1).cells(62, x) + (Worksheets(wk).cells(c2.Row, c1.Column)) & " You are about to overwrite " & (Worksheets("PAY CALCULATOR").cells(2, x)) & "'s" & " current total! Proceed?", vbYesNo, "Confirmation")
            If ans = vbNo And Worksheets("PAY CALCULATOR").cells(2, 18) <> "" Then Exit Sub
     
End If

            Worksheets(wk).cells(c2.Row, c1.Column) = Worksheets(1).cells(62, x) + (Worksheets(wk).cells(c2.Row, c1.Column))
            'Worksheets("Paysheets").cells(c4.Row, c5.Column).Offset(3, 0) = Worksheets("PAY CALCULATOR").cells(2, x) 'intersection of C4 and C5 than count 3 cells to the right

What Im looking to do is from Worksheets("PAY CALCULATOR") is if S2 = Foreman-ExtraEffort then copy the total in S63($200) and add that total to R2 name and his total in R63($240) on Worksheet(wk).

Below is the Worksheet(wk) which is where the total $480 would be copied to once the Save & Clear button is excuted. Date and employee name intersect where the total $480 would be copied to.

Any questions please let me know and Thank you for your help in advance.

 

[MK64]

My VBA is quite rusty, but I'll tell you in words what I think you need to do, and if no one posts something by tomorrow I'll try to put in some code for you. So...

If cells(2,19)="Foreman-ExtraEffort"
Search Employee column in Worksheet "WK" for whatever is in cells(2,18) in Worksheet "PAY CALCULATOR" [use the .Find methd]
If match found, save the row [using the .Address property] (assume is it saved to intRow)
Search the Date row in Worksheet "WK" for whatever date is in cells(2,9) in Worksheet "PAY CALCULATOR" [again, use the .Find method]
If match found, save the column [using the .Address property] (assume it is saved to intColumn)
cells(intRow,intColumn)=cells(63,19) + cells(63,18)

 

[MK64]

Ron - I'm not trying to preach, but something I learned when I first started programming (trained as a programmer back in the 1980's) is to make variable names meaningful. This is incredibly useful when it comes to maintenance of the code (after not having looked at it for 2 years for example), and also if the code ever gets passed on to new individuals to maintain. So, rather than naming the ranges as c1, c2, c3 etc, give them meaningful names. Giving them meaningful names also makes it easier to read and understand the code. Also, in VB and VBA it is common practice to prefix variables names (and object names) with common prefixes. So, for example, an integer variable would be have a prefix of int (as in intRow), a string variable would have a prefix of str (as in strEmployeeName), a variant variable would have a prefix of var, and an array variable would have a prefix of arr. And finally, it is not a good idea to name variables with the same name as a reserved word (is that the correct terminology?). So, in your code you have names a variable as "cells", but Cells is already a reserved word, so this can cause confusion. Of course, naming it rngCells (using the prefix for Range) would make it more obvious in the code when you are referring to the range.

 

[Ron Abba]

Good afternoon,
I have had help putting this code together from other knowledgeable people from here. Im learning as i go so any help s always appreciated.

 

[MK64]

So you have it working?

 

[Ron Abba]

So you have it working?

Threw my back out so been laid up... Here is what I have tried...

Private Sub commandbutton2_click()
ActiveSheet.Unprotect "national"
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim c1 As Range, c2 As Range, c4 As Range, c5 As Range, wk As String, x As Integer
wk = "WEEK " & Worksheets(1).Range("N2")
                For Each cell In Sheets(1).Range("R2", Sheets(1).Range("IV2").End(xlToLeft))
    If cell <> "" Then
        TotalEmployees = TotalEmployees + 1
    End If
Next cell
If TotalEmployees = 2 Then TotalEmployees = 1
If TotalEmployees = 3 Then TotalEmployees = 3
If TotalEmployees = 4 Then TotalEmployees = 2
For x = 18 To 21 'names of installers
Dim cells As Range
Set c1 = Worksheets(wk).Range("C5:I5").Find(Worksheets(1).Range("I2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'searches dates on week1 and week2
Set c2 = Worksheets(wk).Range("B6:B37").Find(What:=Worksheets(1).cells(2, x), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'searches items
Set c3 = Sheet1.Range("B5, F5, J5")
Set c4 = Worksheets("Paysheets").Range("c6:c12").Find(Worksheets(1).Range("I2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False)
Set c5 = Worksheets("Paysheets").Range("D2,D57,D111,D165,D219").Find(What:=Worksheets(1).cells(2, x), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'Range("D2,D57,D111,D165,D219") names
    If Worksheets("PAY CALCULATOR").cells(2, x) <> "" Then
        If Worksheets(wk).cells(c2.Row, c1.Column) <> "" Then
            ans = MsgBox("$" & Worksheets(1).cells(62, x) & " + " & "$" & Worksheets(wk).cells(c2.Row, c1.Column) & "  = " & "$" & _
                Worksheets(1).cells(62, x) + (Worksheets(wk).cells(c2.Row, c1.Column)) & " You are about to overwrite " & (Worksheets("PAY CALCULATOR").cells(2, x)) & "'s" & " current total! Proceed?", vbYesNo, "Confirmation")
            If ans = vbNo And Worksheets("PAY CALCULATOR").cells(2, 18) <> "" Then Exit Sub
           

End If
            Worksheets(wk).cells(c2.Row, c1.Column) = Worksheets(1).cells(62, x) + (Worksheets(wk).cells(c2.Row, c1.Column))
            'Worksheets("Paysheets").cells(c4.Row, c5.Column).Offset(3, 0) = Worksheets("PAY CALCULATOR").cells(2, x) 'intersection of C4 and C5 than count 3 cells to the right
         
[B]If Worksheets("PAY CALCULATOR").cell(2, 19) = "Foreman-ExtraEffort" Then
     Worksheets(wk).cells(c2.Row, c1.Column) = Worksheets("PAY CALCULATOR").cells(62, 19) + (Worksheets(wk).cells(c2.Row, c1.Column))
     End If[/B]

I added that part in bold but is giving me an error "object doesn't support this property or method".

 

[MK64]

It should say ".cells(2,19) =...". You missed the 's' off 'cells'

 

[Ron Abba]

Private Sub commandbutton2_click()
ActiveSheet.Unprotect "national"
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim c1 As Range, c2 As Range, c4 As Range, c5 As Range, wk As String, x As Integer
wk = "WEEK " & Worksheets(1).Range("N2")
                For Each cell In Sheets(1).Range("R2", Sheets(1).Range("IV2").End(xlToLeft))
    If cell <> "" Then
        TotalEmployees = TotalEmployees + 1
    End If
Next cell
If TotalEmployees = 2 Then TotalEmployees = 1
If TotalEmployees = 3 Then TotalEmployees = 3
If TotalEmployees = 4 Then TotalEmployees = 2
For x = 18 To 21 'names of installers
Dim cells As Range
Set c1 = Worksheets(wk).Range("C5:I5").Find(Worksheets(1).Range("I2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'searches dates
Set c2 = Worksheets(wk).Range("B6:B37").Find(What:=Worksheets(1).cells(2, x), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'searches item list
Set c3 = Sheet1.Range("B5, F5, J5")
Set c4 = Worksheets("Paysheets").Range("c6:c12").Find(Worksheets(1).Range("I2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False)
Set c5 = Worksheets("Paysheets").Range("D2,D57,D111,D165,D219").Find(What:=Worksheets(1).cells(2, x), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False) 'Range("D2,D57,D111,D165,D219") names
    If Worksheets("PAY CALCULATOR").cells(2, x) <> "" Then
        If Worksheets(wk).cells(c2.Row, c1.Column) <> "" Then
            ans = MsgBox("$" & Worksheets(1).cells(62, x) & " + " & "$" & Worksheets(wk).cells(c2.Row, c1.Column) & "  = " & "$" & _
                Worksheets(1).cells(62, x) + (Worksheets(wk).cells(c2.Row, c1.Column)) & " You are about to overwrite " & (Worksheets("PAY CALCULATOR").cells(2, x)) & "'s" & " current total! Proceed?", vbYesNo, "Confirmation")
            If ans = vbNo And Worksheets("PAY CALCULATOR").cells(2, 18) <> "" Then Exit Sub
   
End If
[B[B]]If Worksheets("PAY CALCULATOR").cells(2, 19) = "Foreman-ExtraEffort" Then
     Worksheets(wk).cells(c2.Row, c1.Column) = Worksheets("PAY CALCULATOR").cells(62, 19) + Worksheets("PAY CALCULATOR").cells(62, 18) + (Worksheets(wk).cells(c2.Row, c1.Column))[/B][/B]
     End If
            Worksheets(wk).cells(c2.Row, c1.Column) = Worksheets(1).cells(62, x) + (Worksheets(wk).cells(c2.Row, c1.Column))
            'Worksheets("Paysheets").cells(c4.Row, c5.Column).Offset(3, 0) = Worksheets("PAY CALCULATOR").cells(2, x) 'intersection of C4 and C5 than count 3 cells to the right

So now I came up with this but still isnt adding the two cells together... Its like the code isnt seeing this part as an option

 

[Ron Abba]

View attachment 31424

 

[Ron Abba]

If Worksheets("PAY CALCULATOR").cells(2, x) = "Foreman-ExtraEffort" Then
     Worksheets(wk).cells(c2.Row, c1.Column) = Worksheets("PAY CALCULATOR").cells(62, 19) + Worksheets("PAY CALCULATOR").cells(62, 18) + (Worksheets(wk).cells(c2.Row, c1.Column))
     End If

The process should go like this... If Worksheets("PAY CALCULATOR").cells(2, x) (which looks at the names in R2 and S2) and if it = "Foreman-ExtraEffort" Then the total in cells(62,18) would be added to cells(62,19) and that total would end up on under the name of Colavito,Robert on (Worksheets(wk).cells(c2.Row, c1.Column)).