Sabrina Ayon

Hello, HUNTER!
Thanks for sharing your problem with us!
To add a condition in the code from step 1 to only send once a day, you can use a global variable to keep track of the last time an email was sent. Here’s an example of how you can modify the code:

Private lastSentTime As Date

Private Sub Worksheet_Change(ByVal Target As Range)
    'Check if only one cell was changed
    If Target.Cells.Count > 1 Then Exit Sub
    
    'Check if the changed cell is C15
    If Not Application.Intersect(Range("C15"), Target) Is Nothing Then
        'Check if the new value is less than 72
        If IsNumeric(Target.Value) And Target.Value < 72 Then
            'Check if at least one day has passed since the last email was sent
            If Now - lastSentTime >= 1 Then
                'Send the email
                Call Send_Email_Condition_Cell_Value_Change
                
                'Update the last sent time
                lastSentTime = Now
            End If
        End If
    End If
End Sub

In this modified code, the lastSentTime variable is used to keep track of the last time an email was sent. When a cell is changed and meets the criteria for sending an email, the code checks if at least one day has passed since the last email was sent before sending a new email. If less than a day has passed, the code skips sending the email. Once an email is sent, the lastSentTime variable is updated with the current time.

Hope this will help you.
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, AMIR!
Thanks for your comment.

Yes! The code you provided is a simple implementation for converting latitude and longitude to UTM in Excel VBA. However, it is not the most accurate way to convert coordinates, as it uses a simplified formula for converting latitude and longitude to UTM coordinates.

The formula used in this code only accounts for the UTM zone and hemisphere based on the latitude and longitude values. It does not take into account the curvature of the Earth’s surface, which can lead to inaccuracies in the UTM coordinates. If you need this, then you can use the following code:

Function LatLonToUTM(Lat As Double, Lon As Double) As String
    'Declare variables for UTM coordinates
    Dim Zone As Integer, Easting As Double, Northing As Double
    
    'Convert Lat/Lon to UTM using Proj4 library
    Dim Proj As Object
    Set Proj = CreateObject("OSGeo.OSR.SpatialReference")
    Proj.ImportFromEPSG 4326 ' WGS84
    Proj.SetUTM Zone(Lon), (Lat >= 0)
    
    Dim LatLon(0 To 1) As Double
    LatLon(0) = Lon
    LatLon(1) = Lat
    
    Dim xy(0 To 1) As Double
    Proj.TransformPoint xy(0), xy(1), 0, LatLon(0), LatLon(1), 0
    
    'Convert UTM coordinates to string format
    LatLonToUTM = Chr(Zone + 64) & " " & Format(Easting, "0.00") & " " & Format(Northing, "0.00")
End Function

Function Zone(Lon As Double) As Integer
    Zone = Int((Lon + 180) / 6) + 1
End Function

To use this code, open a new Excel workbook, press ALT+F11 to open the VBA editor, and insert a new module. Copy and paste the code into the module, and save the module.
Then, in your Excel sheet, you can use the formula =LatLonToUTM(lat, lon) where lat and lon are the latitude and longitude coordinates you want to convert to UTM format.
This code uses the Proj4 library to perform the coordinate transformation. You may need to install this library on your computer if it is not already installed.
And if you don’t want to use this library. you can use the following code instead.

Function LatLongToUTM(ByVal latitude As Double, ByVal longitude As Double) As String
    
    'Define constants for the conversion
    Const PI As Double = 3.14159265358979
    Const a As Double = 6378137
    Const b As Double = 6356752.3142
    Const k0 As Double = 0.9996
    
    'Convert latitude and longitude to radians
    Dim lat_rad As Double
    Dim long_rad As Double
    lat_rad = latitude * PI / 180
    long_rad = longitude * PI / 180
    
    'Define constants for the conversion
    Dim e As Double
    e = Sqr(1 - (b / a) ^ 2)
    Dim e1sq As Double
    e1sq = (e ^ 2) / (1 - e ^ 2)
    Dim n As Double
    n = (a - b) / (a + b)
    Dim rho As Double
    rho = a * (1 - e ^ 2) / (1 - (e ^ 2) * (Sin(lat_rad) ^ 2)) ^ 1.5
    Dim nu As Double
    nu = a / Sqr(1 - (e ^ 2) * (Sin(lat_rad) ^ 2))
    Dim psi As Double
    psi = nu / rho
    Dim v As Double
    v = (k0 * nu) / psi
    Dim p As Double
    p = long_rad - (2 * PI * Int((long_rad + PI) / (2 * PI)))
    Dim l As Double
    l = (p - 0.2617993877991495) * 180 / PI
    
    'Calculate UTM zone number
    Dim zone As Integer
    zone = Int((long_rad + PI) / (2 * PI)) + 1
    If zone > 60 Then
        zone = zone - 60
    End If
    
    'Calculate UTM x and y coordinates
    Dim x As Double
    Dim y As Double
    x = v * Sinh(l / (2 * 1.005037))
    y = v * (Cosh(l / (2 * 1.005037)) * Tanh(Asinh(Sin(lat_rad) / Sqrt(1 + e1sq * (Cos(lat_rad) ^ 2))) - (e * Atanh(e * Sinh(Asinh(Sin(lat_rad) / Sqrt(1 + e1sq * (Cos(lat_rad) ^ 2))))))))
    
    'Convert x and y to UTM coordinates
    x = x + 500000
    If y  60 Then
        zone = zone - 60
    End If
    
    'Calculate UTM x and y coordinates
    Dim x As Double
    Dim y As Double
    x = v * Sinh(l / (2 * 1.005037))
    y = v * (Cosh(l / (2 * 1.005037)) * Tanh(Asinh(Sin(lat_rad) / Sqrt(1 + e1sq * (Cos(lat_rad) ^ 2))) - (e * Atanh(e * Sinh(Asinh(Sin(lat_rad) / Sqrt(1 + e1sq * (Cos(lat_rad) ^ 2))))))))
    
    'Convert x and y to UTM coordinates
    x = x + 500000
    If y < 0 Then
        y = y + 10000000
    End If
    
    ' Define UTM zone letter
    Dim letters As String
    letters = "CDEFGHJKLMNPQRSTUVWXX"
    Dim zone_letter As String
    zone_letter = Mid(letters, zone, 1)
    
    ' Return UTM coordinates as string
    LatLongToUTM = zone & zone_letter & " " & Format(x, "0.00") & " " & Format(y, "0.00")
    
End Function

This code converts latitude and longitude coordinates to UTM coordinates and returns the result as a string in the format "Zone Letter X Y". You can call this function by passing the latitude and longitude values as parameters, like this:

Sub ConvertLatLongToUTM()
    'Define latitude and longitude values
    Dim latitude As Double
    Dim longitude As Double
    latitude = 37.7749
    longitude = -122.4194
    
    'Call LatLongToUTM function
    Dim utm_coordinates As String
    utm_coordinates = LatLongToUTM(latitude, longitude)
    
    'Display UTM coordinates in message box
    MsgBox utm_coordinates

End Sub

Make sure you have the LatLongToUTM function defined in your VBA code module before running the ConvertLatLongToUTM sub.

Hope this will help you.
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, MRS B!
Can you please send me your excel file via email? ([email protected]), so that I can solve your problem!

Right now I’m giving you a quick solution without the dataset. You can use Excel’s VLOOKUP function to have fields in the payment request form automatically fill in depending on the employee number.

Here is a formula that uses the VLOOKUP function as an example:

=VLOOKUP(employee number,employee table,2,FALSE)

Here, “Employee number” refers to the cell where the employee number input is located, “Employee table” refers to the cell range containing the employee information table, which includes the employee number in the first column, and “2” refers to the column number in the table that contains the university information.

You can change this formula to return different data. Once the relevant information has been obtained from the table, you can use it to fill in the essential fields on the payment request form by utilizing straightforward cell references or other procedures.

Hope this will help you.
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, EHTISHAM SAFDAR!
Thanks a ton for your suggestion!
In Method-7, the precise range we require to count the number of cells containing dates is D5:D12. Determines whether each data value in a given array or range is legitimate by SUM each one.

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, OZTIMS!
Thanks for sharing your problem with us!
Instead of using this format ($General;;), you can use the ($0;-0;;@). This will keep the negative values. To use this follow method-4.

1. When the Format Cells dialog box will appear, go to Number > Custom.
2. Type $0;-0;;@ in the Type field.
3. Finally, click OK.

4. Now, if you see the result, this will also show a negative number. The cell will only be blank if the cell has no data.

Hope this will help you.
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, DONI!
Thanks for sharing your problem with us!
All the methods work properly for me. I am also using Microsoft Office 365.
Can you please send me your excel file via email? ([email protected]).
So that, I can solve your problem.

Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, JHORDISTA!
Thanks for your comment. To format a negative number showing parenthesis, you can add this block of code with any of the above VBA code.

Sub Negative_Numbers()
Range("A1:A10").Select
Selection.NumberFormat = "0.00_);[Red](0.00)"
End Sub

Hope this will help you!
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, ASHLEY!
Thanks for your comment.
Yes. Unfortunately, the google charts API is currently broken. You can use the following API which I updated in the article.

https://chart.googleapis.com/chart?chs=100×100&&cht=qr&chl=

Try out this code below.

Function GenerateQR(qrcode_value As String)
    Dim URL As String
    Dim My_Cell As Range 
    Set My_Cell = Application.Caller
    URL = "https://chart.googleapis.com/chart?chs=100x100&&cht=qr&chl=" & qrcode_value
    On Error Resume Next
      ActiveSheet.Pictures("My_QR_CODE_" & My_Cell.Address(False, False)).Delete
    On Error GoTo 0
    ActiveSheet.Pictures.Insert(URL).Select
    With Selection.ShapeRange(1)
     .Name = "My_QR_CODE_" & My_Cell.Address(False, False)
     .Left = My_Cell.Left + 5
     .Top = My_Cell.Top + 5
    End With
    GenerateQR = ""  
End Function

Hope this will help you!
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, AMIRA!
Thanks for sharing your problem with us!
The code works properly for me.

Can you please send me your excel file via email? ([email protected]).
So that, I can solve your problem.

Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, GABRIEL!
Thanks for sharing your problem with us!
To add a new line you don’t have to write the command .Insert. You can simply use this block of the code to breakline in the string before cFnd.

xTmp = xTmp & Split(Rng.Value, cFnd)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y)
xTmp = xTmp & vbNewLine & cFnd

To use vbNewLine, you have to make sure to do the following.
1. After the ampersand (&) symbol, press the spacebar and get the VBA constant ‘vbNewLine‘.
2. After the constant ‘vbNewLine‘, press one more time space bar and add the ampersand (&) symbol.
3. After the second ampersand (&) symbol, type one more space character, and add the next line sentence in double-quotes.

In VBA, there are three different (constants) to add a line break.
vbNewLine, vbCrLf, vbLf

If this is not working for you, follow the steps.
1. Click on the character you wish to break the line from first.
2. Then, enter a space ( ).
3. Type an underscore (_) after that.
4. Finally, press Enter to finish the line.

Hope this will help you!
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, Rick!
Thanks for sharing your problem with us!
While copying, you have to copy the whole thing (values + formulas). You can have the values (without any formula) only while pasting the copied portion into another place.
While pasting, instead of using ‘.Paste‘ to replicate a formula result as a value rather than the formula itself, use ‘.PasteSpecial‘.

For Each cell In Selection.Columns(3).Cells
If cell.Value = “New York” Then
cell.EntireRow.Copy
Worksheets(“VBA2Copy”).Range(“A” & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
End If
Next

Hope this will help you!
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, JOHN!
Thanks for your comment!
You can lock the row after the date auto updates with the following code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" And Target.Value <> "" Then
    ActiveSheet.Protect Contents:=False
    Range(Target.Address).Locked = True
    ActiveSheet.Protect Contents:=True
End If
End Sub

A cell should only be locked if cell A1 was updated and it is not blank, according to this formula: if Target.Address = “$A$1” and Target.Value > “”
Just substitute the relevant cell value for $A$1 to make the macro function on cell B1, cell D15, or any other cell. For this to function, the column and row references must be preceded by dollar signs.
By changing > “” in the line above to = “desired value,” you may additionally lock the cell only if a certain value was entered, allowing you to do things like lock the cell only if OK was entered or anything similar.

Hope this will help you!
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, MAC!
Thanks for sharing your problem with us!
To integrate these 2 codes, all you need to do is just define the first sub-procedure name in the second part of the code and add the sheet name there before the range-bounded combination. “Worksheet_Change Sheet1.Range(“B5”).Validation…….” like this.

The code should look like this.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo enditall
Application.EnableEvents = False
If Target.Cells.Column = 4 Then
If Target.Cells.Row = 2 Then
N = Target.Cells.Row
If Range("D" & N).Value "" Then
Range("D2").EntireRow.Insert
Range("A2").Select
End If
End If
End If

enditall:
Application.EnableEvents = True
End Sub

Sub CreateDropDownList()
Worksheet_Change Sheet1.Range("B5").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=”Grapes, Orange, Guava, Mango, Apple”

Hope this will help you!
Good Luck!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, AUSTIN!
Thanks for sharing your problem with us!

To convert values into timestamps, follow the instructions below.
1. select the cell and put the formula into that cell.
2. Press Enter.
=(INT(B3/10000)&":"&INT(MOD(B3,10000)/100)&":"&MOD(B3,100))+0

3. This will convert the values into time values.
4. Now, go to Home tab by selecting the resulted cell and click on Number Format drop-down menu under Number group.

5. Drag the Fill Handle icon down to duplicate the formula over the range. Or, to AutoFill the range, double-click on the plus (+) symbol.

6. And, that’s it! But there is an issue. as 13 represent 1 in time, so 13 will replaced by 1.

Hope this will help you!
If not, can you please send me your excel file via email? ([email protected]).

Good Luck!
Best Regards
Sabrina Ayon
Author, ExcelDemy.

Hello, JAMES RICHMOND!
Thanks for sharing your problem with us!
Please follow the method below. You will find your solution there.

https://www.exceldemy.com/copy-hyperlink-in-excel/#3_Copy_Hyperlink_in_Excel_to_Multiple_Sheets

Good Luck!

Regards,
Sabrina Ayon,
Author, ExcelDemy.

Hello, GIA!
As you mentioned, you fill out Column C with data, and Column B will automatically update with the date when Column C was filled out. All you need to do is change the range in your code, and also change the reference argument which is the offset. Try this code below.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Range("C5:C8"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, -1).ClearContents
            Else
                With .Offset(0, -1)
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
            End If
            Application.EnableEvents = True
        End If
    End With
End Sub

Also, you can use the same code for column E to automatically update with the date and time when you fill Column D with “Delivered”. You just have to change the range.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Range("D5:D8"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, 1).ClearContents
            Else
                With .Offset(0, 1)
                    .NumberFormat = "dd mmm yyyy hh:mm:ss"
                    .Value = Now
                End With
            End If
            Application.EnableEvents = True
        End If
    End With
End Sub

Please follow the instructions of the method I linked down.

https://www.exceldemy.com/auto-populate-date-in-excel-when-cell-is-updated/#2_Auto_Populate_Dates_in_Some_Specific_Cells_While_Updating_with_Excel_VBA

Hope this will help you!
Best Regards.

You are most welcome, Wayne Edmondson!
Stay Tuned!

Regards,
Sabrina Ayon
Author, ExcelDemy.

Hello, HANNES!
You can use the same code to generate 2 screenshots (from 2 different ranges) from the same worksheet. All you have to do is, while selecting any range press Ctrl. Then, just Run the code.

Or, you can use the code below, this will convert your excel file range to word document.

Private Sub EmailSS(rng As Range, rng2 As Range, strName As String)
‘To Open Email
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject(“Outlook.Application”)
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
With outMail
.To = strName
.Subject = “** Check this **”
.Importance = olImportanceHigh
.Display
End With
‘To Get Word Document
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
‘To Take Screenshot
rng.Copy
wordDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
wordDoc.Content.InsertParagraphAfter
rng2.Copy
wordDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
outMail.HTMLBody = “Timesheets Submitted by ” & strName & “
” & _
Range(“Text”) & vbNewLine & outMail.HTMLBody
End Sub

Hope this will help you!
Thanks for sharing your problem with use.

Hello, DEMI!
Please follow step 7, you will surely get the Regions button. If you miss any of those steps you won’t get the result. Follow each instruction step by step hopefully, you will find the Regions button.

https://www.exceldemy.com/create-custom-regions-in-excel-3d-maps/#Step_7_Create_Custom_Regions

Good Luck!

Hello, JAMES!
Those codes work properly for pivot table range. Can you please send me your Excel file at [email protected]? So that, I can help you.
Thanks!

Hello, JAN (YAN) WOELLHAF!
If those code does not work for you, try this one! Hope this will help you.

Sub InsertPic()
Dim path As String, photo As Picture, cell As Range
path = “E:\test” & Range(“C3”).Value & “.png”
Set cell = ActiveCell.MergeArea
Set photo = ActiveSheet.Pictures.Insert(PicPath)
With photo
.ShapeRange.LockAspectRatio = msoFalse
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
End With
End Sub

Hello, GERT RENKIN!
Try this code to hide rows except matching values. Hope this will help you!

Sub Hide_Rows()
Dim rng As Long
With Sheets(“Sheet1”)
For rng = 1 To 8
If Cells(5, 1).Value <> Cells(rng, 1).Value Then
.Rows(rng).EntireRow.Hidden = True
End If
Next rng
End With
End Sub

Hello, GRIJESH PRAJAPATI!
If the list of keywords has 2 or more matchable values separated with a comma (,), this will highlight automatically by using the following VBA code.

https://www.exceldemy.com/highlight-specific-text-in-excel-cell-vba/#3_VBA_Code_to_Highlight_Multiple_Specific_Texts_in_a_Range_of_Cells_in_Excel_Case-Insensitive_Match

Hello, DIANA!
There is no problem with your code. What’s the problem actually?
Can you please email me the dataset here; [email protected]

Or you can visit the following article, this may help you to fix your problem.
https://www.exceldemy.com/automatically-send-email-from-excel-based-on-date/

Hello, CRISTIAN!
Please check the article below, you will find the answer to your question.
https://www.exceldemy.com/calculate-travel-time-between-two-cities-in-excel/

Hello, ADITYA AGARWAL!
Try This code. This will automatically protect your spreadsheet after the sheet has been closed.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim WrkSht As Worksheet
Const Password As String = “pass1234”
For Each WrkSht In ThisWorkbook.Worksheets
WrkSht.Protect Password:=Password
Next WrkSht
End Sub

Hope this will help you!

Hello, JOSHUA KROGER!
Please Check the first and the third example. I drop the link here.
https://www.exceldemy.com/excel-macro-to-send-email-automatically/#1_Apply_Excel_VBA_Macro_to_Send_Email_Automatically_Based_on_Cell_Value

https://www.exceldemy.com/excel-macro-to-send-email-automatically/#3_Use_Excel_Macro_to_Send_Email_Automatically_with_Attachments

Hope you will get the solution.
Else you can try this! To use this code, first, you need to create a button.

Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
Dim obj As Object
Set obj = CreateObject(“Outlook.Application”)
Dim objE As Object
Set objE = obj.CreateItem(olMailItem)
Dim rng As Range
Set rng = Range(“A4:A8” & Cells(Rows.Count, “A”).End(xlUp).Row)
Dim rng1 As Range
Dim int As Integer
Dim mailID, CCmailID As String
For Each cell In rng
If Trim(mailID) = “” Then
mailID = cell.Offset(1, 0).Value
Else
If Trim(CCmailID) = “” Then
CCmailID = cell.Offset(1, 0).Value
Else
CCmailID = CCmailID & vbCrLf & “;” & cell.Offset(1, 0).Value
End If
End If
Next cell
Set rng = Nothing
With objE
.To = mailID
.CC = CCmailID
.Subject = “Sending Email with VBA.”
.Body = “This is a Sample Mail.”
.Display
End With
Set objE = Nothing: Set obj = Nothing
ErrHandler:
‘
End Sub

Hello, Anita Sessa!
Do you want to get the same information from a worksheet to another worksheet? If is that so, you can check this Link:
https://www.exceldemy.com/extract-data-from-one-sheet-to-another-in-excel-using-vba/
There are three examples to get the same information from one sheet to another.

Hello, CY!
Yeah, actually this is because I set the cell first as “Range(“C5:C” & row)”. Here as I set cell C5, the element of the C5 cell will show up as the first unique value. You can use other VBA codes also if you want to get unique values with excel features, check this article- https://www.exceldemy.com/excel-unique-values-in-column/
Hope this will help you!

Hello, BOB MARTRAY!
Thanks for noticing.
The formula is now updated!

Hello, JEFF WATKINS!
Yeah! It’s a bad practice, I know!
I will further keep that in mind.
That’s great, you noticed and explain this more specifically.
Thank you so much!

Hello, MICHAEL!
https://www.exceldemy.com/excel-dependent-drop-down-list-multiple-words/
Please, check this article!