Posts by Dogaru

Dogaru · Jul 2nd 2020

HI , are you using Acces database ?

Dogaru · Jul 2nd 2020

Hi all ,

Just asking maybe someone else already done this . I am having issues with an user form to load the fiscal week when it intilializes. I am now using iso function in vba but my fiscal year start the 1st of July and it saying is still in week 52 and it should be week 1. Would you have any ideas on how to make this work ?

Dogaru · Apr 21st 2020

I'm at work now , I will do it when I have a minute.

Dogaru · Apr 21st 2020

try adding this code to the paragraph you want to change the font size

Code

<p style="font-size:12px">your paragraph</p>

Dogaru · Apr 20th 2020

Give it a try now

Code

Set OutMail = OutApp.CreateItem(0)
 toList = Cells(i, 4) 'gets the recipient from col B
 'CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
 eSubject = "Calibration remainder for your " & Cells(i, 5) & " Batching Plant "
 eBody = "<font style=""font-family:Cambria; font-size:12pt;""<font> Dear Sir, <br><br>" _
 & "Greetings from " & "<b> SCHWING STETTER! </b><br><br>" _
 & "Your " & "<b>" & Worksheets("Data").Cells(i, "E").Value & "</b>" _
 & " Batching Plant calibration certificate is going to expire soon ( within " _
 & "<b>" & Worksheets("Data").Cells(i, "I").Value & "</b>" & " days ).<br><br>" _
 & "Plant Last calibration done date is " & "<b>" & Worksheets("Data").Cells(i, "G").Value & "</b>" _
 & " and next due date is " & "<b>" & Worksheets("Data").Cells(i, "H").Value & "</b>" & ".<br><br>" _
 & "Kindly do the calibration on time for accurate batching.<br><br>" & S
"<font style=""font-family:Cambria; font-size:12pt;""<font><font style=""font-family:Cambria; font-size:12pt;""</font>"
 
 On Error Resume Next
 With OutMail
 .To = toList
 .CC = CCList
 .BCC = ""
 .Subject = eSubject
 .HTMLBody = eBody
 .Display ' ********* Creates draft emails. Comment this out when you are ready
 '.Send '********** UN-comment this when you are ready to go live
 End With

Display More

Dogaru · Apr 20th 2020

You have closed the font code , the text you want to format needs to be inside <font>your text here </font>, I have modified your code , try it

Code

Set OutMail = OutApp.CreateItem(0)
 toList = Cells(i, 4) 'gets the recipient from col B
 'CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
 eSubject = "Calibration remainder for your " & Cells(i, 5) & " Batching Plant "
 eBody = "<font style=""font-family:Cambria; font-size:12pt & "" Dear Sir, <br><br>" _
 & "Greetings from " & "<b> SCHWING STETTER! </b><br><br>" _
 & "Your " & "<b>" & Worksheets("Data").Cells(i, "E").Value & "</b>" _
 & " Batching Plant calibration certificate is going to expire soon ( within " _
 & "<b>" & Worksheets("Data").Cells(i, "I").Value & "</b>" & " days ).<br><br>" _
 & "Plant Last calibration done date is " & "<b>" & Worksheets("Data").Cells(i, "G").Value & "</b>" _
 & " and next due date is " & "<b>" & Worksheets("Data").Cells(i, "H").Value & "</b>" & ".<br><br>"  _
 & "Kindly do the calibration on time for accurate batching.<br><br>" & S </font>
 
 On Error Resume Next
 With OutMail
 .To = toList
 .CC = CCList
 .BCC = ""
 .Subject = eSubject
 .HTMLBody = eBody
 .Display ' ********* Creates draft emails. Comment this out when you are ready
 '.Send '********** UN-comment this when you are ready to go live
 End With

Display More

Dogaru · Apr 20th 2020

Solved

Dogaru · Apr 20th 2020

I have sorted the issue, the problem was that the condition that would trigger the module was on column 5 and I had another 5 columns after it , as soon as it met the condition it only added the cell values from the last row up to column 5 where the condition was met and did not added the rest of the last rows in the columns . In order the make it work I have delayed the macro to run for 5 second giving enough time to add data to populate the active sheet, now it works perfect , I have posted the working code maybe someone else has the same issue, I have used the following code:

Code

Option Explicit 
 
Sub sendmail()

Application.OnTime Now + TimeSerial(0, 0, 10), "Mail_small_Text_OutlookMail_small_Text_Outlook"

End Sub Option Explicit 

Sub Mail_small_Text_OutlookMail_small_Text_Outlook()

 Dim lastRow As Long
 'lastRow = Range("A" & .Rows.count).End(xlUp).Row
 lastRow = ListObjects("Table2234").Range.Columns(1).Cells.Find("*", Searchorder:=xlByRows, searchdirection:=xlPrevious).Row
 Dim xOutApp As Object
 Dim xOutMail As Object
 Dim xmailbody As String
 Dim strbody As String
 Set xOutApp = CreateObject("Outlook.Application")
 Set xOutMail = xOutApp.CreateItem(0)
 strbody = Cells(lastRow, 1).Value & "Shift" & vbNewLine & _
 Cells(lastRow, 2).Value & "Date" & vbNewLine & _
 Cells(lastRow, 3).Value & "Raised By" & vbNewLine & _
 Cells(lastRow, 4).Value & "Month" & vbNewLine & _
 Cells(lastRow, 5).Value & "Condition" & vbNewLine & _
 Cells(lastRow, 6).Value & "Opened/Closed" & vbNewLine & _
 Cells(lastRow, 7).Value & "Raised By" & vbNewLine & _
 Cells(lastRow, 8).Value & "Area" & vbNewLine & _
 Cells(lastRow, 9).Value & "Near Miss" & vbNewLine & _
 Cells(lastRow, 10).Value & "Action"
 xmailbody = strbody
 On Error Resume Next
 With xOutMail
 .to = "xxxx"
 .cc = "xxx"
 .BCC = ""
 .Subject = "Serious Near Miss"
 .Body = xmailbody
 .display 
 End With
 On Error GoTo 0
 Set xOutMail = Nothing
 Set xOutApp = Nothing
 
End Sub

Display More

Dogaru · Apr 19th 2020

try

Code

If cells(A1).value = "-*" then
exit sub
end if

Dogaru · Apr 19th 2020

Hello,

I have an issue with trying to insert multiple ranges into an email body. I have the conditions if a cell has a certain value the in sends an email also when it sends the mail it copies the data from last row and it inserts it into the email body , the weird thing is that when I run the sub from the script it works perfectly(picture "from script") BUT when I insert the data from the user form and meets the condition it only gets the data from the first 5 columns (picture "from userform"). If someone can help me I would be very grateful. Thank you in advance

Code

Dim xrg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.count > 1 Then Exit Sub
  Set xrg = Intersect(Range("e:e"), Target)
    If xrg Is Nothing Then Exit Sub
    If Target.Value = "Serious Near Miss" Then
    Call Mail_small_Text_Outlook
    End If
End Sub

Sub Mail_small_Text_Outlook()
    Dim lastRow As Long
    'lastRow = Range("A" & .Rows.count).End(xlUp).Row
    lastRow = ListObjects("Table2234").Range.Columns(1).Cells.Find("*", Searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xmailbody As String
    Dim strbody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    strbody = Cells(lastRow, 1).Value & "Shift" & vbNewLine & _
              Cells(lastRow, 2).Value & "Date" & vbNewLine & _
              Cells(lastRow, 3).Value & "Raised By" & vbNewLine & _
              Cells(lastRow, 4).Value & "Month" & vbNewLine & _
              Cells(lastRow, 5).Value & "Condition" & vbNewLine & _
              Cells(lastRow, 6).Value & "Opened/Closed" & vbNewLine & _
              Cells(lastRow, 7).Value & "Raised By" & vbNewLine & _
              Cells(lastRow, 8).Value & "Area" & vbNewLine & _
              Cells(lastRow, 9).Value & "Near Miss" & vbNewLine & _
              Cells(lastRow, 10).Value & "Action"
    xmailbody = strbody
    On Error Resume Next
    With xOutMail
        .to = "xxxx"
        .cc = "xxx"
        .BCC = ""
        .Subject = "Serious Near Miss"
        .Body = xmailbody
        .display   
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    
End Sub

Display More

Dogaru · Apr 14th 2020

just that post, thanks again RoyUk

Dogaru · Apr 13th 2020

hello , would there be any posibility to remove attached file above as I just realised there is some sensitive data in the workbook, thank you

Dogaru · Apr 12th 2020

thank you Roy , I have also attached the worksheet in a previous post

Dogaru · Apr 12th 2020

also I have attached the example workbook

Dogaru · Apr 12th 2020

Hi RoyUK , I have pasted the code from userform below : as I said in the previous comment , If there is any possibility to search as you type when typing in the combobox as the database is large and it only get larger ,

Code

Private Sub Advice_Click()
If box9.Text = "Did not isolate tools before break" Then
box10.Text = "Always isolate tools before break"
End If
If box9.Text = "Did not isolate tools before break" Then
box10.Text = "Always isolate tools before break"
End If
If box9.Text = "Did not used Zone Stop Before Clearing Jam" Then
box10.Text = "Always use Zone-Stop before clearing jam on high speed line"
End If
If box9.Text = "Did not disconnect saw before going to break" Then
box10.Text = "Always disconnect saw before going to break"
End If
If box9.Text = "Stacked Pallets Over 5 high on His Own" Then
box10.Text = "Always ask for help if the stack is more than 5 high"
End If
If box9.Text = "Carrying a pallet instead of rolling it" Then
box10.Text = "Always roll the pallet when moving it"
End If
If box9.Text = "De-stacking pallets over 5 high on his own" Then
box10.Text = "Always ask for help when De-Stacking pallets over 5 high"
End If
If box9.Text = "Did not empty general waste skip" Then
box10.Text = "When Full , empty the general waste skip"
End If
If box9.Text = "Wood chip bin not emptied" Then
box10.Text = "When full , please empty the bin"
End If
If box9.Text = "Plastic on the floor" Then
box10.Text = "Put plastic in plastic bin"
End If
If box9.Text = "Banding left on the floor" Then
box10.Text = "Put the banding in the bin"
End If
If box9.Text = "Refusing A Reasonable Request" Then
box10.Text = "When asked to do something reasonable , please do it"
End If
If box9.Text = "Using his phone" Then
box10.Text = "We are not allowed to use phone during working hours"
End If
If box9.Text = "Drinking/Eating in the smoking area" Then
box10.Text = "Please, do not drink/eat in smoking area"
End If
If box9.Text = "Spitting" Then
box10.Text = "Please, do not spit"
End If
If box9.Text = "Idiling - Not spending time on his workstation" Then
box10.Text = "Please, spend more time on your bench"
End If
If box9.Text = "Coming late from break" Then
box10.Text = "Please, watch your time keeping"
End If
If box9.Text = "Leaving early for break" Then
box10.Text = "Please, watch your time keeping"
End If
If box9.Text = "Pushing request button when already having pallet on the bench" Then
box10.Text = "Please, repair your pallet first and then ask for another one"
End If
If box9.Text = "Did Not Called Yard Lockdown" Then
box10.Text = "Before entering the yard , always call for yard lockdown"
End If
If box9.Text = "Did Not Hang Tools Back" Then
box10.Text = "Always hang back your tools"
End If
If box9.Text = "Did Not Followed 1-4-1 Blade Procedure" Then
box10.Text = "Always give the blade or the gloves back so you can have a new one"
End If
If box9.Text = "Did Not Removed All Shrink Wrap/Labels From Pallets" Then
box10.Text = "Take plastic/Labels off"
End If
If box9.Text = "Loaded Infeed 21 High" Then
box10.Text = "Please, load 2o pallets to avoid damaging machinery"
End If
If box9.Text = "Left Key Press By COSHH Cabinet Open" Then
box10.Text = "Always close key press"
End If
If box9.Text = "Left Blade Bag On Top Of Timber" Then
box10.Text = "Please, keep the bag with yourself"
End If
If box9.Text = "Left COSHH Cabinet Open" Then
box10.Text = "Please, always close COSHH CAbinet"
End If
If box9.Text = "Drive With Open Forks By Ramp" Then
box10.Text = "When driving , close your forks"
End If
If box9.Text = "Did Not Used Crossing From Car Park To Entrance" Then
box10.Text = "Always use the walkway"
End If
If box9.Text = "Causing Too Many Jams Because Due To Not Removing Pallets That Cannot Travel" Then
box10.Text = "Remove pallets that cannot travel"
End If
If box9.Text = "Nail Filter On Klippa 1 Not Cleaned" Then
box10.Text = "Please clean"
End If
If box9.Text = "Nail Filter On Klippa 2 Not Cleaned" Then
box10.Text = "Please clean"
End If
If box9.Text = "Nail Crates Not Filled" Then
box10.Text = "Please fill nail crates"
End If
If box9.Text = "Not Reporting a Safety Defect During Pre-start Check" Then
box10.Text = "Always report safety defects"
End If
If box9.Text = "Did not isolate tools before break" Then
box10.Text = "Always isolate tools before going for break"
End If
If box9.Text = "Entering The Warehouse Without Earplugs" Then
box10.Text = "Always wear earplugs before entering the warehouse"
End If
If box9.Text = "Not Wearing Apron While Working On The Bench" Then
box10.Text = "Always wear your apron when working on the bench"
End If
If box9.Text = "Working On Inspection Without Using Impact Gloves" Then
box10.Text = "Always use the right gloves when working on inspection"
End If
If box9.Text = "Entering The Warehouse Without Glasses" Then
box10.Text = "Always put your glasses on before entering the warehouse"
End If
If box9.Text = "Working With Damaged Gloves " Then
box10.Text = "Ask for a new pair"
End If
If box9.Text = "Working With Damaged Apron " Then
box10.Text = "Ask for a new apron"
End If
If box9.Text = "Working With Damaged Boots" Then
box10.Text = "Ask for a new pair"
End If
If box9.Text = "Did Not Clean Up His Workstation" Then
box10.Text = "Make sure you keep clean your workstation"
End If
If box9.Text = "Did not empty general waste skip" Then
box10.Text = "Please empty the general waste skip"
End If
If box9.Text = "Wood chip bin not emptied" Then
box10.Text = "emptied the wood chip bin"
End If
If box9.Text = "Plastic on the floor" Then
box10.Text = "Put plastic in the bin"
End If
If box9.Text = "Banding left on the floor" Then
box10.Text = "Put banding in the general waste skip"
End If
End Sub


Private Sub box1_Change()
Dim wks As Worksheet
Set wks = Sheet2






Select Case Me.box1
Case "A"
Me.box6.RowSource = "A"
Case "B"
Me.box6.RowSource = "B"
Case "C"
Me.box6.RowSource = "d"
Case "POLT"
Me.box6.RowSource = "allstaff"
Case "Tesco"
Me.box6.RowSource = "tescostaff"




Case ""
Me.box6.Text = ""
End Select


Select Case Me.box1
Case "A"
Me.box3.RowSource = "aa"
Case "B"
Me.box3.RowSource = "bb"
Case "C"
Me.box3.RowSource = "cc"
Case "POLT"
Me.box3.RowSource = "polt"
Case "Tesco"
Me.box3.RowSource = "tesco"
Case ""
Me.box3.Text = ""




Case Else


End Select
End Sub




Private Sub box5_Change()
Dim wks As Worksheet
Set wks = Sheet2


Select Case Me.box5
Case "Isolation"
Me.box9.RowSource = "isolation"
Case "Manual Handiling"
Me.box9.RowSource = "manual_handelingn"
Case "HouseKeeping"
Me.box9.RowSource = "housekeepingn"
Case "Behaviour"
Me.box9.RowSource = "behaviourn"
Case "Process"
Me.box9.RowSource = "processn"
Case "P.P.E"
Me.box9.RowSource = "ppen"
Case ""
Me.box9.Text = ""
Case Else




End Select
End Sub


Private Sub CommandButton1_Click()


TargetSheet = box4.Text
If TargetSheet = "" Then
Exit Sub
End If
Worksheets(TargetSheet).Activate
lastrow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row


ActiveSheet.Cells(lastrow + 1, 1).Value = box1.Text
ActiveSheet.Cells(lastrow + 1, 2).Value = thedate.Text
ActiveSheet.Cells(lastrow + 1, 3).Value = box3.Text
ActiveSheet.Cells(lastrow + 1, 4).Value = box4.Text
ActiveSheet.Cells(lastrow + 1, 5).Value = box5.Text
ActiveSheet.Cells(lastrow + 1, 6).Value = box11.Text
ActiveSheet.Cells(lastrow + 1, 7).Value = box6.Text
ActiveSheet.Cells(lastrow + 1, 8).Value = box7.Text
ActiveSheet.Cells(lastrow + 1, 9).Value = box9.Text
ActiveSheet.Cells(lastrow + 1, 10).Value = box10.Text
ActiveSheet.Cells(lastrow + 1, 11).Value = count.Text


MsgBox ("Data Added To M.O.T Tracker Successfully")




ListBox1.ColumnCount = 12
ListBox1.RowSource = "A1:K165356"
End Sub




Private Sub CommandButton3_Click()


Dim icontrol As Control


For Each icontrol In Me.Controls
If icontrol.Name Like "box*" Then icontrol = vbNullString
Next






End Sub


Private Sub CommandButton4_Click()
Dim iexit As VbMsgBoxResult


iexit = MsgBox(" Are You Sure You Want To Leave South Ockendon M.O.T Tracker ?", vbQuestion + vbYesNo, "South Ockendon M.O.T Tracker")


If iexit = vbYes Then
Unload Me


End If


End Sub




Private Sub ListBox1_Click()


End Sub


Private Sub UserForm_Initialize()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheet2
ListBox1.ColumnCount = 10
ListBox1.RowSource = "A1:J165356"


'MOT Type




box5.AddItem ("")
box5.AddItem ("Isolation")
box5.AddItem ("Manual Handiling")
box5.AddItem ("HouseKeeping")
box5.AddItem ("Behaviour")
box5.AddItem ("Process")
box5.AddItem ("P.P.E")




'Shift


box1.AddItem ("")
box1.AddItem ("A")
box1.AddItem ("B")
box1.AddItem ("C")
box1.AddItem ("POLT")
box1.AddItem ("Tesco")






'month
box4.AddItem ("")
box4.AddItem ("January")
box4.AddItem ("February")
box4.AddItem ("March")
box4.AddItem ("April")
box4.AddItem ("May")
box4.AddItem ("June")
box4.AddItem ("July")
box4.AddItem ("August")
box4.AddItem ("September")
box4.AddItem ("October")
box4.AddItem ("November")
box4.AddItem ("December")
'area
box7.AddItem ("")
box7.AddItem ("Bench")
box7.AddItem ("Yard")
box7.AddItem ("Warehouse")
box7.AddItem ("Inspection")


'mot category


box11.AddItem ("")
box11.AddItem ("Opened")
box11.AddItem ("Closed")




'count


count.Text = 1






'box 2 date
thedate.Text = Format(Date, "ddd d mmm yyyy")










End Sub

Display More

Dogaru · Apr 10th 2020

Hi guys ,

I am new to VBA and I would need some help with a thing I want to improve on my project.

I have dependant combobox in my data entry form and the database is quite big and it is time consuming going trough the list to add the string . The combobox match text only picks up the first letters of the string so I am not able to type a word and have a result in the combo dropdown list, I have looked over some tutorials but with no success, do you think you can help me , if needed I can attach the workbook

Posts by Dogaru

Connection string to Server

Fiscal Week

Outlook Mail body font size problem

Outlook Mail body font size problem

Outlook Mail body font size problem

Outlook Mail body font size problem

E-mail body range from lastRow

E-mail body range from lastRow

Prevent data entry of text beginning with "-"

E-mail body range from lastRow

Search as you type in dependant combobox

Search as you type in dependant combobox

Search as you type in dependant combobox

Search as you type in dependant combobox

Search as you type in dependant combobox

Search as you type in dependant combobox