VBA To loop each cell in the Column A in excel - excel

In my excel in the column A, there are some date format and some text, I need to identity if each cell in column A if it is a date format or not date format:
Below is my code i try to loop each cell, but it identifies only cell A2, ANy help and ideas . Thanks
Dim strDate As String
Dim rng As Range, cell As Range
Set rng = Range("A2:A17")
With ThisWorkbook.Worksheets("Feuil1")
For Each cell In rng
MsgBox (cell.Value)
strDate = .Range("A2").Value
If IsDate(strDate) Then
MsgBox "This is a date format"
Else
MsgBox "This is not a date format"
End If
Next cell
End With
End Sub

It is because you are assigning .range("A2") to strDate; use the cell object from the for each loop:
Option Explicit
Public Sub CheckDates()
Dim strDate As String
Dim rng As Range, cell As Range
Set rng = Range("A2:A17")
With ThisWorkbook.Worksheets("Sheet1")
For Each cell In rng
MsgBox (cell.Value)
strDate = cell.Value
If IsDate(strDate) Then
MsgBox "This is a date format"
Else
MsgBox "This is not a date format"
End If
Next cell
End With
End Sub

In case you have many lines to check is better to use an array which is faster:
Sub test()
Dim i As Long
Dim arr As Variant
With ThisWorkbook.Worksheets("Feuil1")
arr = .Range("A2:A17")
For i = LBound(arr) To UBound(arr)
If IsDate(arr(i, 1)) Then
MsgBox "This is a date format"
Else
MsgBox "This is not a date format"
End If
Next i
End With
End Sub

Related

Find row where date is between start and end date

First post/question so feel free to let me know if I need to add anything.
In VBA(Excel) I'm trying to find the row where my date variable falls between the start (Column A) and end dates (Column B).
The dates are contiguous, no gaps or overlaps and are all in date format (dd/mm/yyyy) therefore, I should only get one row.
The final row has an end date of 31/12/9999
StartDate
EndDate
01/04/2022
03/04/2022
04/04/2022
02/10/2022
03/10/2022
03/10/2022
04/10/2022
21/02/2023
22/02/2023
31/12/9999
If my date variable was 03/10/2022, I would get row 3. If it was 22/09/2022 I would get row 2.
In SQL I would just do
WHERE date BETWEEN StartDate AND EndDate
How do I do this in VBA?
Sub getrow()
' fails on the if statement
Dim myrow As Integer
Dim myDate As Date
myDate = "01/05/2022"
If myDate >= Sheet9.Range("A:A").Value And myDate <= Sheet9.Range("B:B").Value Then
'i have hardcoded 99 but need it to show the row number where the date falls between column a and b
myrow = 99
Else
myrow = -1
End If
'putting it in a cell for now to see output
Sheet9.Range("c15").Value = myrow
End Sub
Something like this.
Sub BetweenDates()
Dim aCell As Range, bCell As Range
Dim Start
Dim Off
On Error GoTo ErrorHandler
Start = CDate(InputBox("Start:"))
Set aCell = Columns(1).Find(DateValue(Start), LookIn:=xlFormulas)
If aCell Is Nothing Then GoTo ErrorHandler
Off = CDate(InputBox("End:"))
Set bCell = Columns(1).Find(DateValue(Off), LookIn:=xlFormulas)
If bCell Is Nothing Then GoTo ErrorHandler
Worksheets("Sheet2").Cells.ClearContents
Rows(aCell.Row & ":" & bCell.Row).Copy Worksheets("Sheet2").Range("A1")
End
ErrorHandler:
Beep
MsgBox "Not valid Date!"
End Sub
Before:
Enter '1/1/2012' and '1/10/2012'
After:
I got it to work, there is probably a better way to do it.
Sub getrow()
Dim myrow As Integer
Dim myDate As Date
Dim rownum As Integer
myDate = #1/23/2023#
For rownum = 2 To 12
If myDate >= Cells(rownum, 1).Value And myDate <= Cells(rownum, 2).Value Then
myrow = rownum
End If
Next rownum
MsgBox myrow
End Sub
If the data is definitely as you've posted you could use Application.Match.
Sub getrow()
Dim myDate As Date
Dim myrow As Variant
myDate = #1/23/2030#
myrow = Application.Match(CDbl(myDate), Range("A2:A20"), 1)
MsgBox myrow
End Sub

excel alert for cell that auto changes

Hi could someone help adjust this so the alert message says the value of A2 AND B2.
Private Sub Worksheet_Calculate()
Dim myRange As Range
Set myRange = ActiveSheet.Range("F2:F2")
Dim cell As Range
For Each cell In myRange
Evaluate (cell)
If StrComp(cell, "Yes", vbTextCompare) = 0 Then
MsgBox Join(Application.WorksheetFunction.Transpose(Range("A1:A10").Value), Chr$(10))
End If
Next
End Sub
I have modified my original post to comply with your better explanation.
Sub Worksheet_Calculate()
Dim myRange As Range
Dim Cell As Range
Set myRange = ActiveSheet.Range("F2:F2")
For Each Cell In myRange
Evaluate (Cell)
If StrComp(Cell, "Yes", vbTextCompare) = 0 Then
MsgBox "A2 = " & CStr((Cells(2, "A").Value) & vbCr & _
"B2 = " & CStr(Cells(2, "B").Value))
End If
Next Cell
End Sub

Change "dd.mm.yyyy" to "mm/dd/yyyy" VBA

I know "dd.mm.yyyy" is not formatted as date within Excel, and this conversion part is what is getting to me. I have "31.3.2019" within .cell("C5") and want it to convert within the same cell (replace it) with a new formatting of "3/31/2019". I keep on getting an 'out of range' error and I am not sure where my mistake is.
Below is what I have tried:
Sub DivestitureTemplate_ChangeDateFormat()
Application.ScreenUpdating = False
Dim rng As Range
Dim str() As String
Set rng = Range("C5:C3000")
With Worksheets("Divestiture Template")
For Each rng In Selection
str = Split(rng.Value, ".")
rng.Value = DateSerial(2000 + str(4), str(2), str(0))
Next rng
Selection.NumberFormat = "mm/dd/yyyy"
Application.ScreenUpdating = True
End With
End Sub
Change format of ("C5:C3000") from 31.3.2019 to 3/31/2019 -- it can be continuous, but starting at "C5" as this is an automated report and this is below a specified header. I think I have been looking at this, scripting all day and loosing my head over this for no reason.
To get real dates in the column, try:
Sub DivestitureTemplate_ChangeDateFormat()
Dim cell As Range, rng As Range, d As Date
Set rng = Worksheets("Divestiture Template").Range("C5:C3000")
For Each cell In rng
With cell
arr = Split(.Text, ".")
.Value = DateSerial(arr(2), arr(1), arr(0))
.NumberFormat = "m/dd/yyyy"
End With
Next cell
End Sub
EDIT#1:
Sub DivestitureTemplate_ChangeDateFormat()
Dim cell As Range, rng As Range, d As Date
Dim arr
Set rng = Worksheets("Divestiture Template").Range("C5:C3000")
For Each cell In rng
With cell
arr = Split(.Text, ".")
.Value = DateSerial(arr(2), arr(1), arr(0))
.NumberFormat = "m/dd/yyyy"
End With
Next cell
End Sub

excel vba to search for a match

i have a date in Sheet1 A1 and on Sheet2 column A is filled with dates
im looking for something that when assigned to a button and pressed it will look down Sheet2 column A and if any of the dates match Sheet1 A1 it will bring a message box saying match found and if no match is found it will bring up a message box saying no match found
thank you
You can use this code. But don't forget to change the name of the second worksheet if it is required.
Private Sub CommandButton1_Click()
Dim cell As Variant
Dim rangeSheet As Worksheet
Set rangeSheet = Worksheets("Sheet2")
Dim checker As Boolean
checker = False
Dim lastRow As Variant
lastRow = rangeSheet.Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In rangeSheet.Range("A1:A" & lastRow)
If cell.Value = ActiveCell.Value Then
checker = True
Exit For
End If
Next cell
If checker = True Then
MsgBox ("Found")
Else
MsgBox ("Not found")
End If
End Sub
Try this and tell me
Option Explicit
Private Sub CommandButton1_Click()
Dim Sheet1 As Worksheet, Sheet2 As Worksheet
Dim TheDate As String
Dim c As Range
Dim Last As Integer
'Put your own name for your Worksheets
Set Sheet1 = Worksheets("Feuil1")
Set Sheet2 = Worksheets("Feuil2")
'I put the value that you are looking for in the first Worksheets in cells B1
TheDate = Sheet1.Range("B1").Value
Last = Sheet2.Range("a65000").End(xlUp).Row
'All your date are only in the columns A
Set c = Sheet2.Range("A1:A" & Last).Find(TheDate, LookIn:=xlValues)
If Not c Is Nothing Then
MsgBox ("Found ! : " & c.Address)
Set c = Nothing
Else
MsgBox "No match for : " & TheDate
End If
End Sub

Finding the cell position (row,column) by using variable

I have an Excel sheet having one column as date as below :
My Job is to find to the position (cell,column) for a today's date
Script I am using :
Sub MacroExample()
Dim a As Variant
Dim column_Position As Variant
Dim row_Position As Variant
a = Format(Date - 1, "MM\/dd\/yyyy")
'MsgBox "The Value of a : " & a
Dim oRange As Range
Set oRange = Worksheets(1).Range("A1:Z10000").Find(a, lookat:=xlPart)
'MsgBox oRange.Address
MsgBox column_Position
MsgBox row_Position
End Sub
My output should be:
column_Position = 5
row_Position = 1
If I understand what you are asking, I hope this helps. This code should find the first occurrence of today's date in a specified search range.
Sub testDate()
Dim a As Variant
Dim column_Position As Variant
Dim row_Position As Variant
'get today's date, formatted m/d/yyyy
a = Format(Date, "m/d/yyyy")
Dim oRange As range
Dim myCell As range
'set a range to look through
Set oRange = Worksheets(1).range("A1:Z10000")
'check each cell value if it contains today's date. If so, capture the column and row and
'exit the loop.
For Each myCell In oRange
If InStr(1, myCell.Value, a) Then
column_Position = myCell.column
row_Position = myCell.Row
Exit For
End If
Next myCell
'display the column and row position, if wanted.
MsgBox "Column Position is " & column_Position & vbNewLine & "Row Position is " & row_Position
End Sub
Code Result
I cannot say how efficient this is, but it should work.
This will work if you look for a String within some larger string:
Sub MacroExample()
Dim a As String
a = Format(Date - 1, "MM/dd/yyyy")
MsgBox "The Value of a : " & a
Dim oRange As Range
Set oRange = Sheets(1).Range("A1:Z10000").Find(what:=a, lookat:=xlPart)
MsgBox oRange.Column
MsgBox oRange.Row
End Sub
Note:
The date includes the desired leading zeros.

Resources