I am trying to return a list of dates within 30 days of a given day. For example, I want to be able to input todays date and I want excel to search a separate table, with multiple columns of dates. If it finds one within 30 days of today, AND the value of the cell to the left of the date reads "no", then I want it to return the date, the row, and the column.
My initial thought is to define the range of the table and loop through the cells. Then add an if statement that compares each cell with today's date. If they're within 30 days, it will check the value to the left with another if statement. If the value to the left reads no, then it will assign variable = cell value, row number, column number.
In theory, this will leave me with a list of variables that are my matches. Then, all I have to do it report the list of variables in a cell. My vba skills are basic so I need help with the actual diction.
***Update
At this point I'm just trying to get a working loop:
Sub GenerateReport()
'must have selection to work
'Application.DisplayAlerts = True
Dim rng As Range
Dim i As Integer
Dim TD() As Variant
ReDim TD(Selection.Cells.Count)
i = 1
For Each rng In Selection
If IsDate(Cell.Value) Then
If Abs(CDate(Cell.Value) - SearchDate) <= 30 And LCase(Cell.Offset(0, -1).Value) = "no" Then
TD(i) = Cell.Value
Else
TD(i) = 0
i = i + 1
End If
End If
Next
End Sub
I would expect to get a list of 1s and 0s from this, but I can't get it to run.
You could do something along these lines:
Sub GenerateReportFromSelection()
Dim c As Range, col As New Collection, v
For Each c In Selection.Cells
If c.Column > 1 Then 'make sure you can offset one col to left...
v = c.value 'read the value once
If IsDate(v) Then
If Abs(CDate(v) - Date) <= 30 And _
LCase(c.Offset(0, -1).value) = "no" Then
col.Add c 'add cell to collection
End If '30 days + no
End If 'is a date
End If 'col>1
Next
'review the hits
Debug.Print "---Matches---"
For Each c In col
Debug.Print c.value, c.Row, c.Column
Next c
End Sub
Related
My code below has two parts. The first part basically sets a cell as a date that is 6 months from now. This part works but I'm having trouble with the second part.
The second part is after filtering a table, I want to compare each cell in column H (which is a date value) with that future date in the first part. If the date in column H is after the future date, cell AI of that row will be set as "Yes"
Set Database = ThisWorkbook.Worksheets("Sheet1")
Dim i As Long, LastRow As Long
LastRow = Database.Cells(Rows.count, "A").End(xlUp).Row
With Database.Range("AI1")
'Adds 6 months to today's date in cell AI1 in sheet
.Formula = "=EDATE(Today(),6)"
'Converts that date to 1st day of the month (e.g. 17/01/2020 is converted to 01/01/2020
.Value = DateSerial(Year(Range("AI1")), Month(Range("AI1")), 1)
End With
For i = 2 To LastRow
'This line throws a run-time error 13: type mismatch
If Cells(i, "H").SpecialCells(xlCellTypeVisible) > Database.Range("AI1") Then
Cells(i, "AI").Value = "Yes"
End If
Next i
Below should work, with the note that it could replace the value in AI1 on the first loop iteration. Not sure you really want that?
Dim c As Range, vis As Range, dt as Date
'calculate cutoff date
dt = Application.EDate(Date, 6)
dt = DateSerial(Year(dt), Month(dt), 1)
On Error Resume Next 'ignore error if no visible cells
Set vis = database.Range("H1:H" & LastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0 'stop ignoring errors
If Not vis Is Nothing Then 'any visible cells ?
For Each c In vis.Cells
If c.Value > dt Then c.EntireRow.Range("AI1").Value = "Yes"
Next c
End If
I apologize, this is my first crack at Excel VBA so excuse my lack of knowledge!
So I have a list of (currently) 3 names to assign to the days in column A in a repeating order in Excel.
Currently my VBA code allows it to populate the selected cells with the names in a repeating pattern (this part is good), however there are two pieces I need help with.
1- with current code, once it reaches the bottom of the names it checks for the blank box that would end that list and starts over at the tops as directed but it puts a blank cell first (see screenshot). How can I have it put next name without adding blank cell first?
2- I want to be able to (once this gets going)select the entire D column through what dates need to be filled and:
-check the lowest non blank box
-match to list and set the
counter to name below that so
it continues the name order
from the last person who was
assigned
This is code I have now:
Sub EXAMPLE()
Dim count As Integer
count = 0
For Each c In Selection
c.Value = Range("X1").Offset(count, 0).Value
If c.Value = "" Then count = -1 And c.Value = Range("x1").Offset(count, 0).Value
count = count + 1
Next c
End Sub
Sorry I know that was long, I hope this makes sense.
I think it's worth reading about arrays, as this task is ideally suited to their use. Your best bet would be to read the names into an array and then build a recurring array whose dimension is equal to the number of rows in your dates column (or selection, or however you want to define the size of the output range).
Code would look a little like this:
Dim v As Variant
Dim people() As Variant, output() As Variant
Dim rowCount As Long, i As Long, j As Long
Dim endRange As Range
'Read the list of names into an array.
'This just takes all data in column "X" -> amend as desired
With Sheet1
Set endRange = .Cells(.Rows.Count, "X").End(xlUp)
v = .Range(.Cells(1, "X"), endRange).Value
End With
'Sense check on the names data.
If IsEmpty(v) Then
MsgBox "No names in Column ""X"""
Exit Sub
End If
If Not IsArray(v) Then
ReDim people(1 To 1, 1 To 1)
people(1, 1) = v
Else
people = v
End If
'Acquire the number of rows for repeating list of names.
'This just takes all data in column "A" -> amend as desired
With Sheet1
Set endRange = .Cells(.Rows.Count, "A").End(xlUp)
rowCount = .Range(.Cells(3, "A"), endRange).Rows.Count
End With
'Sense check date data.
If endRange.Row < 3 Then
MsgBox "No dates in Column ""A"""
Exit Sub
End If
'Make a recurring array.
ReDim output(1 To rowCount, 1 To 1)
i = 1
Do While i <= rowCount
For j = 1 To UBound(people, 1)
output(i, 1) = people(j, 1)
i = i + 1
If i > rowCount Then Exit Do
Next
Loop
'Write the output to column "D"
Sheet1.Range("D3").Resize(UBound(output, 1)).Value = output
am working on sheet and using the vba for the first time and i love it. but been stuck in one thing for the last few days, after all the reading and searching can not figure how to do this part, here is the scenario I have:
locked sheet and workbook, user can only edit/entre values (numbers) in cells C8:G8 and I8:X8, column H always blank and host no value.
the user is able to hide columns in C8:G8 and I8:X8 if he need to use certain number of columns.
trying to set a macro to identify if a value has been entered more then once within the entire range C8:X8 (excluding H it is empty and any other columns if hidden)
I started with countif and give the perfect results only if all columns are visible:
Sub dup()
Application.EnableEvents = False
Dim x As Variant 'tried with range
Dim n As Variant 'tried with range
Dim rng1 As Range 'tried with variant
Set rng1 = Range("C8:X8")
For Each x In rng1.SpecialCells(xlCellTypeVisible)
If Application.WorksheetFunction.CountIf(rng1, x) > 1 Then
x.Offset(4) = "3" 'used for conditional formatting
Else
x.Offset(4) = "10" 'used for conditional formatting
End If
Next
Application.EnableEvents = True
End Sub
still work when some columns are hidden but it does check through hidden columns and this is not what i want (i want it to skip hidden columns)
some search and reading find out the countif is unable to get the cell property if visible or hidden. tried both options application.countif and application.worksheetfunction.countif
so tried application.match but no luck
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.match(x.Value, rng1.Value, 0)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
tried application.hlookup and not able to get the desired result :
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.HLookup(x.Value, rng1.Value, 1, False)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
it will match the cell itself and look only in the first part of the range C8:G8.
just to explain about the hidden columns situation, the user can hide/show 1,2,3,4 and 5 columns in the first range (if user select 2, only columns C8:D8 will be visible) same apply for range I8:X8, if user select 5 only I8:M8 will be visible) so there will be a case where a hidden column will be in between visible columns.
find few answers on how to use SumProduct(subtotal,...) as a formula only and could not covert it to a VBA.
any recommendation and advise will be appreciated.
Please try this solution.
Sub Dup()
Const Sep As String = "|" ' select a character that
' doesn't occur in Rng
Dim Rng As Range
Dim Arr As Variant
Dim SearchString As String
Dim n As Integer
Dim i As Integer
' needed only if you have event procedures in your project:-
Application.EnableEvents = False
Set Rng = Range("C8:X8")
Arr = Rng.Value
SearchString = Sep
For i = 1 To UBound(Arr, 2)
If Not Columns(Rng.Cells(i).Column).Hidden Then
SearchString = SearchString & Arr(1, i) & Sep
End If
Next i
For i = 1 To UBound(Arr, 2)
' skip blanks, incl. column H, & hidden cells
If (Not Columns(Rng.Cells(i).Column).Hidden) And (Len(Arr(1, i)) > 0) Then
n = InStr(SearchString, Sep & Arr(1, i) & Sep)
n = InStr(n + 1, SearchString, Sep & Arr(1, i) & Sep)
With Rng.Cells(i)
If .Column <> 8 Then ' skip column H
.Offset(4).Value = IIf(n > 0, 3, 10)
' Note that "3" is a string (text) whereas 3 is a number
' It's unusual to enter a number as text because it's use
' for calculations is greatly impaired.
' However, you may modify the above line to write strings
' instead of numbers.
End If
End With
End If
Next i
Application.EnableEvents = True
End Sub
The sub assigns all non-hidden values in the Range to to an array and then reads them into a string (SearchString) in which they are separated by a special character which can be re-defined. All values exist in this string at least once. The second loop looks for the existing value which must be both followed and preceded by the special character because "a" would be found in "ab", "a|" in "ba|" but "|a|" is unambiguous. Then a second search (Instr), starting from after where the first match was found, determines if a duplicate exists. The Iif function then sets the value in the cell 4 rows below the examined cell. Note that the array index is identical to the cell number in the range because of the way the array was created.
Since the Instr function will "find" a null string in position 1 and consider it a duplication by default, null strings aren't processed, not setting any number for the purpose of CF. Column H should therefore be omitted. However, if column H should have any value the CF number will still not be written.
As the sub is called by an event procedure the Application's EnableEvents property should be set in that procedure, not in the sub. This is for greater clarity of the code and has no bearing on the functionality unless the vent procedure also calls other procs.
#Variatus, Sorry to get back on this, after further tests i think i found an issue, if i try to hide any clomun from range C8:G8 (ex : G8 and let say it has same value as M8) the Arr will only look through C8:F8 only, for some reason it doesn't go all the way to X8, and it will mark M8 as duplicate.
or even if the duplicate value is withing I8:X8 it wont find it because the Arr stop at the first hidden cell from the first range
any advise will be appreciated
I am dealing with monthly accruals in an Excel worksheet. I want to write a function or macro that makes it so when the month changes the values become negative.
What I have is a column (K) where it has the month, and another cell (M18) that has the month, And I want the values in the Amount (N) column to become negative if K=M18. But
=if($K21=$M$18,N=N*-1,"") doesn't work. I can write another column off to the side, say Q, where I can write =if($K21=$M$18, N*-1, ""), but I really need for the value in the N column itself to be negative. Is there a way to write a macro or nested functions to replace the value of N with a negative version of itself conditionally? If I have to make the value of negative N calculate in Q, can I then make a second function that goes back and makes N=Q?
K___L__M______N
____Input previous month
____February
___**Venue_Vendor_Amount**
February _______1,666
February ______3,240
February _______718
Here's a macro to do the trick:
Sub AccrualsMacro()
Dim rngN As Range
Dim clVal As Double
Dim cl As Range
Dim makeNegative As Boolean
makeNegative = [K21] = [M18]
If makeNegative Then
Set rngN = Range("N1", Range("N1").End(xlDown))
For Each cl In rngN
With cl
clVal = .Value
If Not clVal < 0 Then 'only apply this rule if the value is still positive
.Value = -1 * clVal
End If
End With
Next
End If
End Sub
Date | data | data | data
12/29| G | F | G
12/30| G | |
I have a spreadsheet like above. I want to find the row that is the current date, then reference the row that is the current date in a Range type. Then cycle through the data in that row.
I can find the current date, and get the address of the cell that is the current date:
dateRange = "A1:" & regionSheet.Range("A1").End(xlDown).Address
For Each cell In regionSheet.Range(dateRange)
If cell.Value = Date Then
row = cell.Address
End If
Next cell
That returns $A$2. I need to somehow turn this into a Range type. I tried using the cell.Address like below:
row = cell.Address & ":" & regionSheet.Range(row).End(xlRight).Address
but that errors out.
Maybe I'm going about this the wrong way? Any ideas?
range(cell, cell.End(xlToRight)).Address
OR
range(cell.Address, range(cell.Address).End(xlToRight)).Address
EDIT: If you want it to have it in Range type, you could use
range(cell, cell.End(xlToRight))
Be warned that the End() function can return incorrect results if there are gaps in the data. For example, if you had data in the second and fourth columns, End will not give you the result you want.
You could try something like this (assumes your data starts in row 1 and column 1):
Sub RowOfCurrentDate()
Dim lngCurrDateRow As Long
Dim lngNumCols As Long
Dim rngDates As Range
Dim rngToday As Range
Dim c As Range
'Get current region and count the number of columns
Set rngDates = Range("A1").CurrentRegion
lngNumCols = rngDates.Columns.Count
'Resize the range down to one column
Set rngDates = rngDates.Resize(rngDates.Rows.Count, 1)
'Find today's date in the range
lngCurrDateRow = Application.WorksheetFunction.Match(CLng(Date), rngDates, 0)
'Set the range to search through for today
Set rngToday = Range(Cells(lngCurrDateRow, 1), Cells(lngCurrDateRow, lngNumCols))
'then loop through all cells in that range
For Each c In rngToday
'if cell is not empty
If Len(c) > 0 Then
'do something
End If
Next c
End Sub