highlight cells before specified date in column - excel

I have a column of dates in the format MM/DD/YYYY and want to highlight specific ranges of these dates. For example, the first section of highlighted dates should be everything from the first row all the way up to the current friday. Sometimes that date is not in the sheet so I have a few extra lines that check if that date is not listed, it will check for the current thursday. When using the .find method of searching the column I am having issues and also am having issues saying I am using an end if without an if statement even though I am. Kind of confused on the errors I am getting.
Dim friday As Date
Dim rng As Range
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A:A, C:C, H:H, J:J").Delete
friday = Date + 8 - Weekday(Date, vbFriday)
Columns("C:C").Select
Set rng = Selection.Find(What:=friday, After:=Range("C1"),
LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then rng.Select
Else: friday = friday - 1
End If

It's hard to tell exactly what you're trying to do with the code. You're using .Find to look for friday, but then you don't seem to be doing anything after that. Also, avoid using .Select when possible. It's not necessary to select data to perform some action on it. This code will look at all the values in column A and highlight the dates equal to friday:
Sub test()
Dim friday As Date
Dim sht_data As Worksheet
Dim i, LastRow as long
Set sht_data = ThisWorkbook.Sheets("Data") 'change to your sheet name
friday = Date + 8 - Weekday(Date, vbFriday) 'get date for comparison
With sht_data
LastRow = .Cells(Cells.Rows.Count, 1).End(xlUp).Row 'get last row
For i = 1 To LastRow 'assumes data starts in first row
If .Cells(i, 1).Value = friday Then
.Cells(i, 1).Interior.Color = RGB(255, 255, 0) 'highlight yellow
Else: End If
Next i
End With
End Sub
You can play with that to highlight ranges of datas (i.e. update the If clause to check for a range).

Related

Find a cell containing a specific date

I have a excel serving as timeline record. Column B contains date of a year, and columns right on it record various event.
I want to make a button which can jump to the row of current date. The first thing I try to do is find a cell with specific date in it. I get a date from a existing cell in column B, then turn back to find it. However the Find method returns nothing.
Sub gotoToday()
Dim LDate As Date
Dim dateCol As Range
Dim cell As Range
LDate = Range("b197").Value ' do get a valid date value here
Set dataCol = Range("B2:B365") ' b197 is inside the range
dataCol.Select
Set cell = Selection.Find(what:=LDate, after:=ActiveCell, LookIn:=xlFormulas, _
Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
cell.Select ' cell get Nothing here
End Sub
Basically I am following This stackoverflow post. Not sure what thing I am missing, can any one help me out?
My guess is that you are looking for a Date type (Dim LDate As Date) whereas dataCol contains strings. Try looking for a string:
Dim LDate As String
'...
LDate = Range("b197").Text
'...
EDIT
You can get a string from a date, formatted to your liking, by using the Format function. Example:
LDate = Format(Range("b197").Value, "mm/dd/yyyy")
If your values in column B really are dates, computed using formulas and formatted as mm/dd, the Find will work with LDate as a string and LookIn:=xlValues, even if they are displayed without the year.

2 Problems with a VBA Macro and Date Formating

I have looked at other posts but cannot find anything that is similar enough to my problems. Any help will be appreciated.
I have a set of dates that come in everyday; the dates come in the following format: DD.MM.YYYY (I live in a country that has the day first). I need the data to change into DD/MM/YYYY. I then use these dates in a Vlookup as part of the data set that holds the information I wish to retrieve.
I need help with the following problems:
Problem # 1
When I use the macro and switch the "." with the "/", days 1 to 12 have been switched to the following format DD/MM/YYYY. However, the actual month and day have switched. Currently working in April so 01.04.2020 has been switched to 04/01/2020 (Reading as January fourth); 04/02/2020 (February second and so on....). How can I prevent this from happening so that everything stays in place and just the "." and the "/" change.
Problem #2
From day 13 and onwards the format looks right “13/04/2020”, however when I use it in the Vlookup, the formula will not bring any results back. In order for the Vlookup to work, I have to go to the cell that I just changed and press delete in front of the first digit, even though there is no space there; in order for the Vlookup to work.
Why does that happen? What can I do it so it work right after replacing the “.” and the “/”
Below is my code
Sub Dates()
Range(Range("G12"), Range("G12").End(xlDown)).Select
Selection.NumberFormat = "dd.mm.yyy"
Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.NumberFormat = "dd/mm/yyy"
End Sub
Try,
Sub test()
Dim vDB, rngDB As Range
Dim s As Variant
Dim i As Long
Set rngDB = Range("G12", Range("G12").End(xlDown))
vDB = rngDB
For i = 1 To UBound(vDB, 1)
s = Split(vDB(i, 1), ".")
vDB(i, 1) = DateSerial(s(2), s(1), s(0))
Next i
rngDB = vDB
rngDB.NumberFormatLocal = "dd/mm/yyyy"
End Sub
Error Image
Correct Image
Here is a solution for your code as is.
I strongly recommend reading and further understanding How to avoid Select in Excel VBA to improve your code and reduce risk of runtime errors.
If you add this code to the bottom of your existing procedure (as it is shown in your question) it will loop through each cell and re-format it to the correct date value.
Dim myCell As Variant
Dim myRange As Range
Set myRange = Selection
For Each myCell In myRange
myCell.Value = Format(CDate(myCell), "DD/MM/YYYY")
Next
You might find this link helpful also:
Better way to find last used row
If you refine your code taking into account the information in both links, you will end up avoiding .Select and Selection. entirely, and your target range/cell will be less ambiguous.
I'd reformat it as follows:
Note: I have written this on Sheet1 of a new workbook, you would need to change the Sheets("...") reference to match your sheet name.
Sub dates()
Dim myRange As Range
Dim LastRow As Long
Dim myCell As Range
With ThisWorkbook.Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, 7).End(xlUp).Row
Set myRange = Range("G12:G" & LastRow)
For Each myCell In myRange
myCell.Value = Replace(myCell, ".", "/")
myCell.Value = Format(CDate(myCell), "DD/MM/YYYY")
Next myCell
End With
End Sub
Now it's a lot clearer where on our workbook we are making changes which helps improve readability for yourself and others (such as other users on SO) along with reduces ambiguity and risk of RunTime errors.
Thanks for the text to column advise this is what I did for it to work:
Sub Dates ()
Dim rg As Range
Set rg = Range("G12").CurrentRegion
rg.TextToColumns Destination:=Range("H2"), ConsecutiveDelimiter:=True, DataType:=xlDelimited, Other:=True, OtherChar:="."
lr = ActiveSheet.Cells(Rows.Count, "G").End(xlUp).Row
Range("K2").Formula = "=DATE(J2,I2,H2)"
Range("K2").AutoFill Range("K2:K" & lr)

VBA Macro with offset

I'm trying to create a simple macro for a sheet I use every day at work.
Basically it's about:
Sheet 1 Cell A2:A11 has values in it those values need to be copy pasted into sheet 2 to with an offset each day to the next free column.
What I've got so far is the copy paste with one offset...but I don't know how to say that the offset should happen for the next free column.
Dim rng As Range
Dim ws As Worksheet
Range("A2:A11").Select
Selection.Copy
Sheets("Sheet2").Select
If rng Is Nothing Then
'if nothing found - search for last non empty column
Set rng = ws.Range("2:2").Find(What:="*", LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
If rng Is Nothing Then
Set rng = rng.Offset(, 1)
ActiveSheet.Paste
End If
If I understand correctly, try just using this instead of all your current code
Range("A2:A11").Copy Sheets("Sheet2").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
Set rng = rng.End(xlToRight).Offset(0, 1)
You go all the way right and then one more for the next free column.

Format a range of columns based on their title - Excel

I've got part of a solution but it isn't working like I'd hope, so I've come to you for advice.
I regularly receive Excel files where I need to amend formatting. I'm trying to learn VBA by automating as much of these procedures as possible.
One particular format I complete is converting the date to "DDMMYYYY" (09091986), where it usually comes in as 09/09/1986.
Within my worksheet, there are a total of 3 columns containing dates, all of which need the same formatting and all of which have the word "DATE" in the heading. They are not adjacent to each other.
I must also be careful not to have any other data affected, as I have names and addresses which may contain the characters "DATE".
So, background out of the way... I'm trying to search the first row until I find the word "Date" and then format that for each cell until the last row, before moving on to the next column containing the word "DATE" and repeating this until all columns with the word "DATE" have been formatted.
I'm sure you have a simple solution but I can't seem to find it myself.
Here is the code I have...
Sub Dateformat()
Dim LastRow As Integer
Dim FindCol As Integer
Dim C1 As Integer
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
FindCol = Cells.Find(What:="DATE", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
For C1 = 2 To LastRow
Cells(C1, FindCol).NumberFormat = "DDMMYYYY"
Next C1
End Sub
This works for the first column containing date but doesn't move on to the next column.
Thanks for the help
Regards,
Adam
As you know, you need to loop through and find each Row Header with DATE
Here is one way to do it.
Sub Dateformat()
Dim wks As Worksheet
Dim LastRow As Integer
Dim FindCol As Range
Dim sAdd As String
Set wks = ThisWorkbook.Sheets("Sheet1") ' adjust as needed
With wks
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'find first instance where DATE exists in row 1 (headers)
Set FindCol = .Rows(1).Find(What:="DATE", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
'store address of first found instance (to check in loop)
sAdd = FindCol.Address
Do
'format column (row 2 to last used row)
.Range(.Cells(2, FindCol.Column), .Cells(LastRow, FindCol.Column)).NumberFormat = "DDMMYYYY"
'this line works as well and is a bit cleaner
'.Cells(2, FindCol.Column).Resize(LastRow - 1, 1).NumberFormat = "DDMMYYYY"
'find next instance (begin search after current instance found)
Set FindCol = .Cells.FindNext(After:=FindCol)
'keep going until nothing is found or the loop finds the first address again (in which case the code can stop)
Loop Until FindCol Is Nothing Or FindCol.Address = sAdd
End With
End Sub

Excel VBA - Using Find method on a range of dates

I am trying to find if a certain date is in a range of dates.
This is the range of dates:
01/01/2013
11/02/2013
29/03/2013
20/05/2013
01/07/2013
05/08/2013
02/09/2013
14/10/2013
11/11/2013
25/12/2013
26/12/2013
Here is the VBA code:
' Format Holiday Rows '
With ConfigData.Range("B8:B18")
Set holidays = .Find(s1.Cells(row_count, 1))
If Not holidays Is Nothing Then
MsgBox s1.Cells(row_count, 1)
End If
End With
In the above code, the first MsgBox that pops up reads "11/01/2013". This makes absolutely no sense, as that value is not in the range.
Note: ConfigData.Range("B8:B18") refers to the range of dates shown above.
ALSO: This code is within a for loop that increments the value of s1.Cells(row_count, 1). Starting at 01/01/2013 until 31/12/2013
If you just want to confirm a calendar day in your series is within the holiday list, then you could even use vlookup:
Dim strFound As String
On Error Resume Next
strFound = Application.Vlookup(s1.Cells(row_count, 1), .Range("B8:B18"), 1, 0)
If IsError(strFound) Then
MsgBox "Not Found"
Else
'-- Found
End If
On Error GoTo 0
The following code works for me:
Sub thing()
Dim cell As Range, _
holidays As Range
For Each cell In Range("D1:D365")
With Range("A1:A11")
Set holidays = .Find(cell.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not holidays Is Nothing Then
Debug.Print cell.Value
End If
End With
Next cell
End Sub
If this doesn't work, I'd suggest it's likely you have a cell formatting issue. Select one of your date cells. Go to the immediate window (Alt+F11, then Ctrl+G from Excel), type ? Selection.Value2 and press enter. Does that return a numeric value (~41000)?
Alternatively, you could reenter the dates in a completely new sheet (enter the first couple manually and drag down, do not copy and paste as formatting will be copied also) and try again. This should at least remove odd formatting as a potential issue.
It is important to note that excel uses american date formatting. ie mm/dd/yyyy and it can therefore be a little tricky to get the .Find() function to work properly. Make sure your variables are formated properly in order for excel to hopefully give you what you're looking for:
Dim strdate As String
Dim aCell As Range
strdate = ActiveSheet.Cells(1,1)
strdate = Format(strdate, "Short Date")
On Error Resume Next
Set aCell = Cells.Find(What:=CDate(strdate), After:=Range("A1"), LookIn:=xlFormulas , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rCell Is Nothing Then
MsgBox("Date cannot be found. Try Again")
End If
End Sub
Of course there are a lot of annoying things that can happen with the date formatting, but this is assuming the dates you're looking for ar in the "Short Date" format.
'To find a cell elsewhere in a worksheet with the same specific date as a reference cell:
'First copy all dates to cells immediately to their left.
'Format the copied cells as "General"
'Run this code - then use the dateRow and DateCol variables (eg in vlookup)
'Works in Excel 2013 (The "General" column must not be hidden - Hide by formatting in background colour)
Dim dateVal
Dim DateRow
Dim DateCol
dateVal = Range("j8").Value 'must be in general format
Cells.Find(What:=dateVal, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
DateRow = ActiveCell.Row
DateCol = ActiveCell.Column
MsgBox (DateRow & " " & DateCol)
End Sub

Resources