VBA alternative to a PIVOT table

Hi all,

Needing help with data manipulation to show only the lines the represent the end result for an employees pay period.

Brief contexts:
An employee can be paid certain elements such as Ordinary hours, Leave hours, overtime etc.. Each row of data is made up of one of these elements.
One row per element however employee can have multiple rows per payperiod.


Where things get interesting is, employees can have additional retrospective lines, which are displayed as either a negative or positive.
A negative means that it will negate the pay element where it was previously applied.
A positive means that the value of the pay line is added to the element that was previously applied.

If you are still following then great!, if not I totally understand.

I have attached an example book of what I have done so far, which primarily consists of adding "DELETE" flags then delete the marked rows at the end, however this is
a) far too slow, when i have over 300K rows
b) not entirely the most robust solution.

The reason this won't work in a PIVOT table, is where an employee has a negative retrospective line with a different rate of pay. The only options become showing the MAX of MIN rate.

Hi, Sorry now attached

Also, i have commented out the "Delete" sub, so you can see what lines it is deleting

I have made the code work, except it runs pretty slowly, about 1.5 seconds per each EMP_REF_unq statement.

Any ideas on how to speed this up?

here is the code:

Sub Test_Wage_PIVOT_Alternitave()
'============================================
' CODE WORKS as of 12.08.2020
'============================================

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView


Sheets("Multiwage_NEW").UsedRange.ClearContents
Sheets("Temp_M").UsedRange.ClearContents
    
With Worksheets("Ref")
    Dim LastRow_REF_EmpID As Long
    LastRow_REF_EmpID = .Cells(.Rows.Count, "C").End(xlUp).Row
End With


For Each EMP_REF_unq In Sheets("Ref").Range("C2:C" & LastRow_REF_EmpID)

    Sheets("Temp_M").UsedRange.ClearContents
    Dim LastRow_Multiwage As Long, i As Long, j As Long
    
    With Worksheets("Multiwage")
       LastRow_Multiwage = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    With Worksheets("Temp_M")
       j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    Sheets("Temp_M").Range("A1:X1").Value = Sheets("Multiwage").Range("A1:X1").Value
    Sheets("Multiwage_NEW").Range("A1:X1").Value = Sheets("Multiwage").Range("A1:X1").Value

    For i = 1 To LastRow_Multiwage
        With Worksheets("Multiwage")
            If .Cells(i, 1).Value = EMP_REF_unq Then
                .Rows(i).Copy Destination:=Worksheets("Temp_M").Range("A" & j)
                j = j + 1
            End If
        End With
    Next i

    Dim LastRow_TEMP_M As Long
    With Worksheets("Temp_M")
        LastRow_TEMP_M = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Sheets("Temp_M").Range("A1").Sort Key1:=Sheets("Temp_M").Columns("K"), Header:=xlYes
    
    For Each EMP_REF_For_WageLine In Sheets("Temp_M").Range("A2:A" & LastRow_TEMP_M)
    With Sheets("Temp_M").Range("A2:A" & j)

            
            Dim SEARCH_VALUE_WageType As String, SEARCH_VALUE_WageType_HOURS As String, SEARCH_VALUE_WageType_PayScaleGroup As String, START_ROW_TO_SEARCH_VALUE_WageType As String
            
            SEARCH_VALUE_WageType = EMP_REF_For_WageLine.Offset(0, 23)
            SEARCH_VALUE_WageType_HOURS = EMP_REF_For_WageLine.Offset(0, 15)
            SEARCH_VALUE_WageType_PayScaleGroup = EMP_REF_For_WageLine.Offset(0, 13)
            
            SEARCH_VALUE_WageType_address = EMP_REF_For_WageLine.Offset(0, 23).Address
            SEARCH_VALUE_WageType_Row = Split(SEARCH_VALUE_WageType_address, "$")(2)
            START_ROW_TO_SEARCH_VALUE_WageType = SEARCH_VALUE_WageType_Row + 1
            
            Dim FindString As String
            Dim Rng As Range
            FindString = SEARCH_VALUE_WageType
            If Trim(FindString) <> "" Then
                With Sheets("Temp_M").Range("X" & START_ROW_TO_SEARCH_VALUE_WageType & ":X" & j + 1)
                    Set Rng = .Find(What:=FindString, _
                                    After:=.Cells(.Cells.Count), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False)
                    If Not Rng Is Nothing Then
                        '*****Code for when wagetype is found
                        EMP_REF_For_WageLine.Offset(0, 15) = SEARCH_VALUE_WageType_HOURS + Rng.Offset(0, -8)
                        Rng.Offset(0, 1) = "DELETE"
                        Rng = ""
                        Rng.Offset(0, -8) = ""
                    Else
                    End If
                End With
            End If
    End With

    Next EMP_REF_For_WageLine
    
    Delete.Remove_Superseded
    Delete.Remove_Zero
    
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    
    Dim LastRow_TEMP_M2 As Long
    
    LastRow_TEMP_M2 = Sheets("Ref").Cells(Rows.Count, "C").End(xlUp).Row
    
    Set copySheet = Worksheets("Temp_M")
    Set pasteSheet = Worksheets("Multiwage_NEW")
    
    copySheet.Range("A2:X" & j).Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    
    Count = Count + 1
    Application.StatusBar = Count & " out of " & LastRow_TEMP_M2 - 1 & " completed."


Next EMP_REF_unq

Application.StatusBar = False
   
Application.StatusBar = "Done!"

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
End Sub

Sorry sintek

The initial objective was to delete rows that have been superseded by another row (This happens when there is a wage element such as ORD that is a negative value of equal amount of hours.
The code i posted is the modified version that will search for the wage element and add or subtract hours based on the found results (if it is positive or neg) then remove the found lines (if any found)

To summarize in steps:
1. copies the pay period into a temp sheet from the master file for an individual employee
2. for each row in the temp sheet, search the wage element (ord hours, overtime etc...)
3. if results are found (more than the value that starts the search), then add the hours associated to that found value to the search value hours. Then delete the hours from the result element and add the text "DELETE" to the end column (this is for the deletion of the not useful rows at the end)
4. if not found, then do nothing (this means there was no superseding entry for that wage element)
5. when all wage elements are looked through then run the "Delete" function which is not listed in the code
6. copy results to a different sheet
7. Go to the next loops to the top again.


Hopefully this covers it! let me know if i need to clarify something

The only real purpose of the temp sheet, is so i can see pause break the code while writing it to compare the output with with original. if the process of the temp sheet really adds to the time of the code running, i can remove it.

an example of how it should work...

Row 2 is the first entry of ORD (Ordinary hours) of 16.
Row 7 is a negative of the same wage type description so will deduct two hours from Row 2
Row 19 is a negative for a different period so will not affect the Row 2.
The end result is Row 2 to having 14 hours

I forgot to mention, to make the code work in the original book that I uploaded, you will need to put this formula in Col X which acts as a helper column

=O2&"_"&N2&"_"&M2

In summary, the code looks for the value in Col X and if found, then adds the hours to the row the search was based off. so if the hours added are neg or pos, it will still calculate correctly.

Hope this makes more sense, sorry for the ambiguous postings