Payment received, file sent via PM
Posts by KjBox
-
-
I have a solution for you, I will PM you with my PayPal details.
-
I can look at this for you
-
Do you have access to a system using Office 2010 or Office 365?
It may be worth copying your files to that system and running the code, if the speed is back to what it used to be, then the problem must be to do with Office 2019. In that case I suggest you reach out to microsoft for help.
-
If you are calling 22 of the 23 macros from just one macro (or calling others from a macro which itself had been called) then you need to set ScreenUpdating to False, Calculation to Manual and Enable Events to False at the start of the macro that calls the first one, and reverse the settings at the end of that macro. Remove all ScreenUpdating, Calculation and EnableEvents code from all the other macros, otherwise you are turning them on and off 23 times instead of just once! That should improve the speed.
You could also try running a VBA Code Cleaning programme, there are quite a number available on the internet, Ribbon Commander is very good as it works for both 32 and 64 Bit systems, whereas most only work on 32 Bit systems.
As you have already discovered, converting as much Object based code as possible to Array based code will make a huge speed improvement.
-
-
You will probably find that the selected cell does get a yellow border but that border is not visible while the cell is selected because excel has a black border to show the selected cell. Fill does work and show though.
Attached is a file to do what you want, but with a yellow fill rather than a yellow border. The address of your previous selection is stored in Cell F1 which has the Defined Name "PrevADD" (you can use any cell on your sheet which is not being used and name it "PrevAdd", if you set the font colour of that cell to be the same as the cell fill colour then the text will not be visible).
Bold font and yellow fill will be applied to any selected cell that is not empty, you can further refine the code to work only on particular columns or rows, or on a specified range.
The code in the sheet Object Module is
Code
Display MorePrivate Sub Worksheet_SelectionChange(ByVal Target As Range) Dim r As Range Set r = Range([PrevAdd]) With r .Font.Bold = 0 .Interior.Color = xlNone End With If Target.Address <> [PrevAdd].Address Then If Target <> "" Then With Target .Font.Bold = 1 .Interior.Color = vbYellow End With [PrevAdd] = Target.Address End If End If End Sub
-
-
I can look at this for you
-
-
You're welcome
-
You don't need line 6 of the code either. My amendment to your original code merely added an extra If..Then..End If statement to account for the current month being January. All you need to do is add your code for getting the previous month's data after each "Then".
-
Possibly something along these lines
CodeIf Month(Date) > 1 Then If Year(x(i, DtCol)) = Year(Date) And Month(x(i, DtCol)) = Month(Date) - 1 And x(i, 3) = ContAreas(ii) And x(i, 7) = Category And x(i, 8) = InspType Then 'Your code here End If ElseIf Year(x(i, DtCol)) = Year(Date) - 1 And Month(x(i, DtCol)) = 12 And x(i, 3) = ContAreas(ii) And x(i, 7) = Category And x(i, 8) = InspType Then 'Your code here End If End If
-
-
Not sure if Roy is looking at this for you or not, I can if he isn't
-
Try this.
My code will generate a string of Email recipients who meet the combo box criteria. That string can then be parsed to your emailing code to be used in the "To" bit of the code (.To sTo)
Code
Display MoreOption Explicit Sub Email_Recipients() Dim x, i As Long, sS As String, sP As String, sRecps As String x = Sheet2.Cells(1).CurrentRegion sS = Sheet1.cbSubject: sP = Sheet1.cbPriority For i = 2 To UBound(x, 1) If x(i, 3) = sP And x(i, 9) = sS Then If sRecps <> "" Then sRecps = sRecps & x(i, 5) Else sRecps = x(i, 5) End If Next If Len(sRecps) Then Send_Email_Excel_Attachment_Early_Binding sRecps End Sub Sub Send_Email_Excel_Attachment_Early_Binding(sTo As String) MsgBox "I will write code for outlook here" End Sub
-
Try the attached.
On Sheet 1 the cell linked to the List Box is E2, The list of weekdays starting in J2 is used to populate the list box (you can move it anywhere, even to a hidden sheet, it is a named range "Days". That named range is also used in the code.
The code assigned to the ListBox is
-
The code will depend upon whether you are using a Form Control Listbox or an ActiveX one. Attach your workbook
-
Alternatively try the attached, click the button on Sheet 1.
Code assigned to the button:
Code
Display MoreSub OrganiseData() Dim x, y, i As Long, ii As Long, iii As Long x = Sheet1.Cells(1).CurrentRegion ReDim y(1 To UBound(x, 1) / 8, 1 To 8) For i = 1 To UBound(x, 1) Step 8 ii = ii + 1: iv = i - 1 For iii = 1 To 8 y(ii, iii) = x(iii, 1) Next Next With Sheet2 .Cells(1).CurrentRegion.Clear With .[a1].Resize(UBound(y, 1), 8) .Value = y With .Columns(5).Resize(, 2) .NumberFormat = "h:mm" .HorizontalAlignment = -4131 End With .Columns(8).Font.Color = RGB(107, 165, 58) End With .Activate .Columns.AutoFit Application.Goto .[a1] End With End Sub
-
Why is Row 1 of Sheet1 like it is?