Posts by KjBox

I am pretty certain there is a way of speeding up your code, but need to see your actual file, or a least a truely representitive example of it.

You are lucky, today is Sunday, it is raining here, and I had nothing better to do so I did all you wanted.

Your file attached with new codes.

Click the "Filter by Class Type" button, a list box with all the Class Types will appear, select from that list as required (it is set to multi-select), 2 more buttons will appear, click "Apply Filter(s)" to colour the font in the 'Instructor Pay Data' sheet column Z where Column J is the selected value(s), and filter the 2 pivot tables on the 'Instructor Summary' sheet excluding the selected item(s).

Click the "Clear Filtering" button to clear all pivot table filtering and to clear the list box and hide it plus the 2 buttons.

Note I added a filtering field to your pivot tables, I also put a line of code in the Workbook_Open procedure that will protect the 'Instructor Pay Data' sheet and set "User Interface Only" to True, that means all codes will work for changes to that sheet without the need to unprotect then re-protect the sheet (but it remains protected for user trying to make changes manually).

As you say it is a lot to ask in a free forum!

What you want should be possible, I will do something to get you started, but for a full solution I suggest you need to post in the Hire Help Forum.

Can you post you complete code

The code works perfectly with the sample file you posted.

So, either that sample was not a true representation of your actual file, or your actual file has some other data that causes the code to produce the error.

I cannot say which without seeing your actual file.

You are going to have to unprotect the sheet using ActiveSheet.Unprotect <password> at the start and ActiveSheet.Protect <password> at he end.

I cannot say what to do about ScrollArea without seeing your actual sheet and code.

Change

x = [t4].CurrentRegion.Rows(5)

to

x = [t4].CurrentRegion.Rows(Selection.Row - 3)

CurrentRegion is a block of cells without empty rows or columns, Rows(5) is the 5th row of that block.

So all the data in the 5th row of the current region starting in cell T4 gets loaded into array x

Payment received, many thanks.

Your file attached, click the button to show user form the click the "Calculate" button.

I have a solution for you.

I will PM you my PayPal details and post the file here upon payment.

I can look at this for you

Try changing

For i = 5 To lastcolumn

to

For i = 5 To lastcolumn Step 5

You create a PDF with your first Sub, then create another one with the second sub.

Change the path in the first sub from

"C:\Google Drive\Business Office Work\Accounting\Invoices\"

to

"C:\Google Drive\Business Office Work\Accounting\Invoices\Business\"

If it is a business Invoice.

You will need to add an If....Else.....End If statement to your code to determine if it is a Business Invoice or a General Invoice.

Then do not use your second Sub.

Try the attached test file, click the "Copy Data" button on Sheet1

Rather than modify the code you got from ChatGPT, I made a new, more efficient code.

Code assigned to the button:

Sub CopyData()
    Dim ws1 As Excel.Worksheet, ws2 As Excel.Worksheet, lRow&
    Set ws1 = Worksheets("Sheet1"): Set ws2 = Worksheets("Sheet2")
    
    With ws1
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 2
        Application.ScreenUpdating = 0
        If .Cells(3, 1) <> vbNullString _
        And Application.CountA(.Cells(3, 11).Resize(lRow)) = lRow Then
            ws2.[b23] = .[a3]: ws2.[c23] = .[b3]: ws2.[e23] = .[c3]: ws2.[f23] = .[d3]
            ws2.[b22] = .[g3]: ws2.[b13] = .[h3]: ws2.[b20] = .[l3]: ws2.[c20] = .[k3]
        End If
    End With
    
End Sub

Not sure why you got 2 entries for Day 4 Hour 22, I did not!

Try changing Line 44 of the code

While iii < UBound(x)

To

While iii <= UBound(x)

Not sure what you mean by "run it again to get results", clicking the button a second time changes nothing.

It might help if you included a sheet which shows the result you expect.

Try the attached, click the button on Sheet1.

Code assigned to the button:

Sub RemDupsSort()
    Dim x, i&, ii&, iii&, s$, r As Range
    x = ActiveSheet.[c2].CurrentRegion
    
    With ActiveSheet.[c2].CurrentRegion
        x = .Value2
        For i = 2 To UBound(x)
            For ii = 1 To UBound(x, 2) - 1 Step 2
                s = x(i, ii) & x(i, ii + 1)
                iii = i + 1
                While iii < UBound(x)
                    If x(iii, ii) & x(iii, ii + 1) = s Then
                        x(iii, ii) = vbNullString
                        x(iii, ii + 1) = vbNullString
                    End If
                    iii = iii + 1
                Wend
            Next
        Next
        .Value2 = x
        Application.ScreenUpdating = 0
        For i = 1 To UBound(x, 2) - 1 Step 2
            Set r = .Columns(i).Resize(, 2)
            r.Sort .Columns(i + 1), , , , , , , 1
            r.Sort .Columns(i), , , , , , , 1
        Next
    End With
    
End Sub

That works for all scenarios, very neat to add a trailing space before SUBSITUTE if no bracket, then remove the space again with TRIM! Much neater than what I came up with to do it using a formula which was:

=IF(RIGHT(A1,1)=")",SUBSTITUTE(SUBSTITUTE(A1,"0(","("),"0(","("),IF(AND(RIGHT(A1,1)="0",MID(A1,LEN(A1)-1,1)="0"),LEFT(A1,LEN(A1)-2),IF(RIGHT(A1,1)="0",LEFT(A1,LEN(A1)-1),A1)))

However, HGVIET did specify a VBA solution, maybe his actual workbook would not work if an extra column with a formula solution was added, rather than updating the values in the required column in situ.

Yes, Rory, that will remove up to 2 trailing zeros from the unbracketed number and leave anything within the brackets untouched. But, as I understand it, there may not be a bracketed number, in which case no trailing zeros are removed.