VBA code help with mod

Ron Abba

New Member
Joined
Jun 25, 2020
Messages
12
Office Version
  1. 2016
Good evening,
New to VBA and looking to mod some code to preform an additional step.
VBA Code:
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).
1612224183322.png


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.
1612225171306.png


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

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

MK64

New Member
Joined
Jan 31, 2021
Messages
7
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

New Member
Joined
Jan 31, 2021
Messages
7
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

New Member
Joined
Jun 25, 2020
Messages
12
Office Version
  1. 2016
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

New Member
Joined
Jan 31, 2021
Messages
7

ADVERTISEMENT

So you have it working?
 

Ron Abba

New Member
Joined
Jun 25, 2020
Messages
12
Office Version
  1. 2016
So you have it working?
Threw my back out so been laid up... Here is what I have tried...
VBA Code:
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

New Member
Joined
Jan 31, 2021
Messages
7

ADVERTISEMENT

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

Ron Abba

New Member
Joined
Jun 25, 2020
Messages
12
Office Version
  1. 2016
VBA Code:
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
 
Last edited:

Ron Abba

New Member
Joined
Jun 25, 2020
Messages
12
Office Version
  1. 2016
VBA Code:
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)).
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,836
Messages
5,766,720
Members
425,373
Latest member
ndiejennrrd

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
Top