Check out some similar questions!

rsdjimbie · Apr 14, 2009, 06:27 AM

I have an Excel spreadsheet witch I use for my wage calculations.
Annually I have to submit a report to government showing total amount earned by each worker as well as total income tax deducted. Wages are calculated and paid fortnightly.
I have a counter like this example,” Mycount = Range("P3") + Range("L6")
Range("P3") = Mycount” and works very well for invoice date and number changes, but my wages spreadsheet works with 600 people, and I do not know how to apply this counter to 600 entries without having to retype each entry. Isn’t there some sort of copy, paste technique I can use?

JBeaucaire · Apr 14, 2009, 08:52 AM

You'll need to clarify if the value to increment is always in column P, for instance P3, and if the value to ADD to it is always in column L and 3 rows below, for instance L6.

Where would the NEXT value be? P8? P10?

Once you clearly describe the "pattern" that your sheet follows to layout the values of 600 employees in columns P and L, I can write you a "loop" that will update the values in column P.

A shorter piece of code:

Code:

Range("P3").Value = Range("P3").Value + Range("L6").Value

rsdjimbie · Apr 14, 2009, 11:34 PM

The counter I gave was only a example.
All the individual earnings lies in column Q4 to Q600. I will "count" (add) this to col. AB4 to AB600.
The tax deducted is in col S4 to S600 and the "counter" amount in col AC4 to AC600.

JBeaucaire · Apr 15, 2009, 12:10 AM

Well, I'm not sure what you're doing, so I just answered your specific question on how to code an incrementing value with VBA. If I were creating this sheet, I wouldnt' be using VBA for this.

The problem with VBA is that it does things permanently.

You're doing this payment process every two weeks, right? So isn't there a history in your data? Don't you have a sheet for each payroll period?

As I add a new sheet for each payroll period, I would use formulas to bring over the values from the previous sheet and add the new values on the current sheet. This would insure I could SEE how the values were amassed over time payroll by payroll.

If you use VBA to increment the values on a single sheet, how will you know for sure it's right?

rsdjimbie · Apr 15, 2009, 01:22 AM

Originally Posted by JBeaucaire

Well, I'm not sure what you're doing, so I just answered your specific question on how to code an incrementing value with VBA. If I were creating this sheet, I wouldnt' be using VBA for this.

The problem with VBA is that it does things permanently.

You're doing this payment process every two weeks, right? So isn't there a history in your data? Don't you have a sheet for each payroll period?

As I add a new sheet for each payroll period, I would use formulas to bring over the values from the previous sheet and add in the new values on the current sheet. This would insure I could SEE how the values were amassed over time payroll by payroll.

If you use VBA to increment the values on a single sheet, how will you know for sure it's right?

don't know how to make this simpler but here goes.
The same spreadsheet is used for every fortnightly payout. The only thing changing is the current date. All the information, ie.: names stays the same. If a person resigns from the company, then he remains on the spreadsheet as "history" and only is removed after financial year end.

Name Basic Payment PAYE deduction Counter Pay Counter PAYE
M.Phootha R 465.30 R50.00 ? ?

Now, how do I, without having to sit and type for 600 individual entries, the counter cell reference, like in your example, Range("P3").Value = Range("P3").Value + Range("L6").Value ?
"P3" and "L6" would have to be changed individually to P4,P5,P6 etc. and the same for the rest.
This manual typing changing cell reverence is what I am trying to avoid here.
The counter VBA can be run via a manual update button.

rsdjimbie · Apr 15, 2009, 07:10 AM

Ok even more simple: a+b=b where a changes but b is the counter, ie: a=10+b=10=20, then a=50+b=20=70 thanks.

JBeaucaire · Apr 17, 2009, 10:24 AM

Ok, a simple macro will do this, I'm just confused by the fact that you don't seem to have all of one person's data in a single row.. not confused, just concerned about getting this right.

Your first example wants to add L6 into P3... different rows... a concern.

Then your next example shows matching ranges: Q4:Q600 added into AB4:AB600

Now that second example is much more encouraging. I can write you a quick macro that runs through column Q and add the values found on every row into the value already in column AB. Would that work?

If the data REALLY is on the same row... Q4 gets added to AB4, Q5 gets added into AB5, etc... just run this macro:

Code:

Option Explicit

Sub IncrementWithholding()
Dim i As Integer
i = 4

Do    
    Range("AB" & i).Value = Range("AB" & i).Value + Range("Q" & i).Value
    i = i + 1
Loop Until Range("AB" & i).Value = 0
End Sub

If your data set includes gaps and problems, try this one:

Code:

Sub IncrementWithholding2()
Dim i As Integer

For i = 4 To Range("Q" & Rows.Count).End(xlUp).Row
    Range("AB" & i).Value = Range("AB" & i).Value + Range("Q" & i).Value
Next i

End Sub

And if neither work correctly, then I really will need to see some of that data... a good sample set.

If you don't mind, upload the sheet itself, or a smaller set of 10 rows or so with the names changed to Name1, Name2, etc. This will let me create a perfect macro. Make sure any junk below your current dataset is included in this sample... so I can see if I need to work around anything down there or if the coast is clear.

It probably wouldn't hurt to add a DATE/TIME stamp to your sheet that this macro can update every time it is run, too. Then you'd know for sure it's been run already. We could even build in a test against that timestamp so if you tried to run it a second time within a certain number of days, it warns you and gives you a chance to say "nevermind." Like so:

Code:

Sub TimecheckIncrement()
Dim i As Integer

If Range("AZ1").Value < Date - 10 Then
    For i = 4 To Range("Q" & Rows.Count).End(xlUp).Row
        Range("AB" & i).Value = Range("AB" & i).Value + Range("Q" & i).Value
    Next i
    Range("AZ1").Value = Date
ElseIf MsgBox(("Last date update was run was :" & Range("AZ1").Value & ", do you still wish to run this update again?"), vbYesNo + vbCritical) = vbYes Then
    For i = 4 To Range("Q" & Rows.Count).End(xlUp).Row
        Range("AB" & i).Value = Range("AB" & i).Value + Range("Q" & i).Value
    Next i
    Range("AZ1").Value = Date
End If

End Sub

rsdjimbie · Apr 18, 2009, 03:37 AM

Thank you, all of the loops seem to work OK.
I have uploaded the spreadsheet so you can create a monster macro.

I have simplified the sheets and all are referring to same col. For makro to run.

I need the macro to run through each sheet (cutting,line a, line b etc.) doing the same calculations.

So, for each sheet I need Col. "S" added to Col. "AD" and Col. "AB" to "AC", where "AC" and "AD" are destination cells for sum value.

These VBA loops are far more complicatet then what I thought, thank God for this website and your help!

Thank you.

JBeaucaire · Apr 18, 2009, 08:09 PM

Give this macro a try, it applies to every every worksheet in the workbook it is run on. Also, rather than needing to UNPROTECT the worksheets, I just set the protection flag "UserInterfaceOnly:=True" so that the sheets can stay protected and the macro will still run. That flag keeps users from editing the sheets, but lets macros run freely. Nifty.

Code:

Option Explicit
Sub IncrementYTDwDateCheck()
' code by Jerry Beaucaire (4/18/2009)
Dim i As Integer, ws As Worksheet
Application.ScreenUpdating = False
Sheets(1).Activate
If Range("AC2").Value < Date - 10 Then
    Range("AC2").Value = Date

    For Each ws In Worksheets
    ws.Activate
    ws.Protect Password:="", userinterfaceonly:=True

        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
    Next ws
    
ElseIf MsgBox(("Last date update run was on" & Range("AC2").Value & ", do you still wish to run this update again?"), vbYesNo + vbCritical) = vbYes Then
    Range("AC2").Value = Date
    
    For Each ws In Worksheets
    ws.Activate
    ws.Protect Password:="", userinterfaceonly:=True
        
        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
    Next ws
End If

Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

This code does do the date check, the date is stored on Sheet1 ("cutting") in cell AC2, so if you try running the macro twice, watch what happens.

========
For chuckles and giggles I reviewed all the other macros in the sheet and there was a LOT of speed to be gained by tightening up the code, which I did. You can try my versions against your old ones, or just read through them to see how selecting cells/ranges and activating sheets is frequently unnecessary... and slows down code execution.

The macro recorder records six lines af activity for this:

Code:

Sheets("Line A").Select
Range("A4:L4").Select
Selection.Copy
Range("A4:L100").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

But that should then be edited down so that it executes faster WITHOUT the selections, like so:

Code:

Sheets("Line A").Range("A4:L4").Copy
Sheets("Line A").Range("A4:L100").PasteSpecial Paste:=xlPasteFormulas, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Anyway, there was a lot of that to be simplified. Also, on the macros that unprotect sheets at the top, then do stuff, then protect again, I just protected at the top with the "UserInterfaceOnly:=True" so the macros could run, they are never unprotected.

Have a look around at them. Even with the macro I ADDED, tightening the other macros knocked 20k off the file size.

rsdjimbie · Apr 19, 2009, 12:36 PM

Beautiful beautiful BEAUTIFUL!
You are really brilliant!
I've been busy with this for about 2months, and you do it in a weekend!

One more thing, due to the upload file size restriction, I had to deleate some 6 other sheets that also works with this spreadsheet, and the macro now wants to run on these sheets as well where the macro is not needed. How do I change the code to run on certain sheets only?

Thanks again Jerry.

JBeaucaire · Apr 19, 2009, 04:34 PM

Have a look at the other macros. I used an Array("Line A", "Line B") trick at the top of several of them.

I bet if you just look them over you can see how to substitute my For Each ws in Worksheets into For Each ws in Array()

You can do it... (hehe) (Hint: NewWeekStart)

JBeaucaire · Apr 19, 2009, 04:42 PM

Your module23, take a look at this macro and compare it to your original, see how FOR / NEXT loops can greatly reduce repetitive functions?

Code:

Sub UpdateColGtoLAllSections()
Dim ws As Worksheet
'
' UpdateColGtoLAllSections Macro
' Macro recorded 17/03/2009 by Renier Struwig
' edited by Jerry Beaucaire (4/19/2009)
Application.ScreenUpdating = False

For Each ws In Array("Cutting", "Line A", "Line B", "Line C", "Line D", "Quality", "General")
    ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
    ws.Range("G4:L4").Copy
    ws.Range("G5:L100").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next ws
    
For Each ws In Array("Dispatch", "Office")
    ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
    ws.Range("G4:L4").Copy
    ws.Range("G5:L50").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next ws

    Sheets("Adjustments").Range("Q22").Select
    
Application.ScreenUpdating = True
End Sub

rsdjimbie · Apr 20, 2009, 12:02 AM

Did give it a go, but gives "Variable not defined" error on " "ws".

JBeaucaire · Apr 20, 2009, 01:44 AM

Show me the whole macro... be sure to wrap the code in [code] tags.

rsdjimbie · Apr 20, 2009, 03:32 AM

Code:

Option Explicit
Sub IncrementYTDwDateCheck()
' code by Jerry Beaucaire (4/18/2009)
'
For Each ws In Array("Cutting", "Line A", "Line B" _
                , "Line C", "Line D", "Quality", "General", "Dispatch", "Office")
    ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
Next ws

Dim i As Integer, ws As Worksheet
Application.ScreenUpdating = False
Sheets(1).Activate

If Range("AC2").Value < Date - 10 Then
    Range("AC2").Value = Date

    For Each ws In Array()

    ws.Activate
    ws.Protect Password:="", userinterfaceonly:=True

        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
    Next ws
    
ElseIf MsgBox(("Last date update run was on" & Range("AC2").Value & ", do you still wish to run this update again?"), vbYesNo + vbCritical) = vbYes Then
    Range("AC2").Value = Date
    
    For Each ws In Array()

    ws.Activate
    ws.Protect Password:="", userinterfaceonly:=True
        
        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
    Next ws
End If

Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

JBeaucaire · Apr 20, 2009, 01:34 PM

Hehe, you've gotten things a little out of order there... you tried to USE the "ws" variable before you'd even declared it (Dim was as Worksheet).

Keep your declarations at the top:

Code:

Option Explicit
Sub IncrementYTDwDateCheck()
' code by Jerry Beaucaire (4/18/2009)
Dim i As Long, ws As Worksheet
Application.ScreenUpdating = False

Sheets(1).Activate
If Range("AC2").Value < Date - 10 Then

    Range("AC2").Value = Date

    For Each ws In Array("Cutting", "Line A", "Line B", "Line C", "Line D", _
                        "Quality", "General", "Dispatch", "Office")
    
        ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
        ws.Activate
        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
        
    Next ws
    
ElseIf MsgBox(("Last date update run was on" & Range("AC2").Value & ", do you still wish to run this update again?"), vbYesNo + vbCritical) = vbYes Then

    Range("AC2").Value = Date
    
    For Each ws In Array("Cutting", "Line A", "Line B", "Line C", "Line D", _
                        "Quality", "General", "Dispatch", "Office")
    
        ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
        ws.Activate
        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
    Next ws
End If

Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

rsdjimbie · Apr 20, 2009, 11:30 PM

Eeesh, changed date to be changed to sheet 5, still won't run. Try it on the spreadsheet I sent u.

Code:

Option Explicit
Sub IncrementYTDwDateCheck()
' code by Jerry Beaucaire (4/18/2009)
Dim i As Long, ws As Worksheet
Application.ScreenUpdating = False

Sheets(5).Activate
If Range("AC2").Value < Date - 10 Then

    Range("AC2").Value = Date

    For Each ws In Array("Cutting", "Line A", "Line B", "Line C", "Line D", _
                        "Quality", "General", "Dispatch", "Office")
    
        ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
        ws.Activate
        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
        
    Next ws
    
ElseIf MsgBox(("Last date update run was on" & Range("AC2").Value & ", do you still wish to run this update again?"), vbYesNo + vbCritical) = vbYes Then

    Range("AC2").Value = Date
    
    
    For Each ws In Array("Cutting", "Line A", "Line B", "Line C", "Line D", _
                        "Quality", "General", "Dispatch", "Office")
    
        ws.Protect Password:="", userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
        ws.Activate
        For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
            Range("AD" & i).Value = Range("AD" & i).Value + Range("S" & i).Value
            Range("AC" & i).Value = Range("AC" & i).Value + Range("AB" & i).Value
        Next i
    Next ws
End If

Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

JBeaucaire · May 4, 2009, 09:09 AM

Is this still giving you problems?

rsdjimbie · May 4, 2009, 11:59 PM

No, all OK.

rsdjimbie · May 5, 2009, 12:08 AM

No all is oh now thanks.