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.
Posts by KjBox
-
-
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.
-
-
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
-
-
You create a PDF with your first Sub, then create another one with the second sub.
Change the path in the first sub from
to
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:
Code
Display MoreSub 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 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:
Code
Display MoreSub 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.
-
=SUBSTITUTE(A1,"00","") would fail if the number in the brackets was 100, i.e. A1 was "100(100)"
Also fails if A1 is "12003400(3)" since only the last 2 zeros of the unbracketed number need to be removed.
-
LOL, yes it is Vietnamese
-
Do you mean this:
If A3 in sheet1 is not blank AND Sheet1 Column K all rows in table are completely filled in then
- Copy Sheet1 A3 to Sheet2 B23
- Copy Sheet1 B3 to Sheet2 C23
- Copy Sheet1 C3 to Sheet2 E23
- Copy Sheet1 D3 to Sheet2 F23
- Copy Sheet1 G3 to Sheet2 B22
- Copy Sheet1 H3 to Sheet2 B13
- Copy Sheet1 L3 to Sheet2 B20
- Copy Sheet1 K3 to Sheet2 C20
Or this
If A3 in sheet1 is not blank then
- Copy Sheet1 A3 to Sheet2 B23
- Copy Sheet1 B3 to Sheet2 C23
- Copy Sheet1 C3 to Sheet2 E23
- Copy Sheet1 D3 to Sheet2 F23
- Copy Sheet1 G3 to Sheet2 B22
- Copy Sheet1 H3 to Sheet2 B13
And if Sheet1 Column K all rows in table are completely filled in then
- Copy Sheet1 G3 to Sheet2 B22
- Copy Sheet1 H3 to Sheet2 B13