I am trying to change a column of text-based dates in a table into valued dates, so I can later filter them in the next line of code. I wanted the code to go through each row, get the value from the Due Date column, and return the date in the correct format. I get a Run-time error 438 - Object doesn't support this property or method.
'changes the date to correct format
For Each Row In ActiveSheet.ListObjects("ISP_Table")
DueDate = Range("ISP_Table[Due Date]")
Range("ISP_Table[Due Date]") = DateValue(DueDate)
Next Row
'filters out dates more than 3 months in the future
ActiveSheet.ListObjects("ISP_Table").Range.AutoFilter Field:=3, Criteria1:="<" & DateAdd("m", 1, Date)
Loop over the cells in the .DataBodyRange of the ListColumn in question:
Dim cell As Range
For Each cell in ActiveSheet.ListObjects("ISP_Table").ListColumns("Due Date").DataBodyRange
cell.Value = DateValue(cell.Value)
Next
Since looping cell-by-cell is slow, even better, use an array:
Dim rng As Range
Set rng = ActiveSheet.ListObjects("ISP_Table").ListColumns("Due Date").DataBodyRange
Dim arr() As Variant
arr = rng.Value ' read values into array
Dim i As Long
For i = Lbound(arr, 1) to Ubound(arr, 1)
arr(i, 1) = DateValue(arr(i, 1))
Next
rng.Value = arr ' write array back to sheet
Related
when I run find and replace through vba it changes my dates to us format. So I have a column of dates, but they are all prefixed with text that I want to remove (like so Invoice Date:dd/mm/yyyy). When I use Ctrl + F and replace manually, it's all great. Removes the text, the date remains in it's original format dd/mm/yyyy. However, when using vba to do this it changes the dates to mm/dd/yyyy if the the day is less than 12 (ie months in a year). I've tried a number of different methods to convert it but they all seem to have the same problem. Here is my latest failure...
Sub DateConvert()
Sheets("Sheet1").Select
Dim strValue As String
Dim RowCount As Integer
Dim x As Integer
Dim DateValue As Date
RowCount = WorksheetFunction.CountA(Range("C1", Range("C1").End(xlDown)))
For x = 2 To RowCount
'changes cell value to a string
strValue = Cells(x, 3).Value
'removes unwanted text
Cells(x, 3).Replace _
What:="Invoice Date:", Replacement:=""
'changes to string to desired date format
DateValue = Cells(x, 3).NumberFormat = "dd/mm/yyyy"
Next x
End Sub
Please, someone spare me this misery before either the laptop or me go out the window.
Thanks in advance
Dates are extremely annoying to work with. Your best bet for making sure you're working with the correct date is to use the DateSerial function, and then format the output as desired:
Sub DateConvert()
Dim ws As Worksheet: Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim rData As Range: Set rData = ws.Range("C2", ws.Cells(ws.Rows.Count, "C").End(xlUp))
If rData.Row < 2 Then Exit Sub 'No data
'Load range data into an array
Dim aData() As Variant
If rData.Cells.Count = 1 Then
ReDim aData(1 To 1, 1 To 1)
aData(1, 1) = rData.Value
Else
aData = rData.Value
End If
'Loop over array and perform conversion
Dim aDateValues As Variant
Dim i As Long
For i = 1 To UBound(aData, 1)
aDateValues = Split(Replace(aData(i, 1), "Invoice Date:", vbNullString), "/") 'Remove the extra text and pull the date values
aData(i, 1) = DateSerial(aDateValues(2), aDateValues(1), aDateValues(0)) 'Use DateSerial to guarantee correct date
Next i
'Output results to sheet with desired date format
With rData
.Value = aData
.NumberFormat = "dd/mm/yyyy"
End With
End Sub
I have created a code to use Vlookup formula through VBA but i am stuck that how to fix it. It is very simple to lookup a range but i do not know what to do. Any help will be appreciated.
Sub Example()
Dim value As Range
Dim table As Range
Dim col_index As Range
Dim FinalResult As Variant
lRow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
Set value = Sheet2.Range("A2")
Set table = Sheet1.Range("A2:D15")
Set col_index = Sheet2.Range("D2:D" & lRow)
FinalResult = Application.WorksheetFunction.VLookup(value, table, col_index, False)
End Sub
Here is the formula which is working perfectly
=VLOOKUP(Sheet2!A2,Sheet1!$A$2:$D$15,4,FALSE)
Edited
Sub Example()
Dim value As Range
Dim table As Range
Dim col_index As Range
Dim FinalResult As Variant
lRow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
Set value = Sheet2.Range("A2")
Set table = Sheet1.Range("A2:D15")
FinalResult = Application.WorksheetFunction.VLookup(value, table, 4, False)
End Sub
Edited but still not working
Sub Example()
Dim rng As Range
Dim table As Range
Dim col_index As Range
Dim FinalResult As Variant
lRow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = Sheet2.Range("A2")
Set table = Sheet1.Range("A2:D15")
FinalResult = Application.WorksheetFunction.VLookup(rng, table, 4, False)
rng.value = FinalResult.value
End Sub
Assume you have two tables.
Your data table in "Sheet1"
Your output table where you want the result ("Sheet2").
To get the countries from the data sheet ("Sheet1") you would use the formula (I use ";" as separator as I use nordic version of excel):
=VLOOKUP(Sheet2!A2,Sheet1!$A$2:$D$15,4,FALSE)
So in VBA this would look like this:
Sub Example()
Dim tbl As Range
Dim col_index As Range
Dim Lookup_val As Long 'if you use a numerical number as in my example
'Dim Lookup_val As String 'if you use a text or words + numbers as lookup criteria
Dim FinalResult As Variant 'I would consider to use string or long... more specific declaration if you know the datatype to be retrieved.
lRow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row 'End row in the column we should WRTIE the answer from the vlookup function
EndRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row 'End row of the range we would like to MATCH values
Set tbl = Sheet1.Range("A2:D15") 'Data table range
For i = 2 To EndRow 'What range we should loop through. We want to loop from row 2 until the last row in Column A for Sheet2
Lookup_val = Sheet2.Cells(i, "A").value 'Value that should be use as lookup value in the "vlookup function"
FinalResult = Application.WorksheetFunction.VLookup(Lookup_val, tbl, 4, False) 'Perform the vlookup function
Sheet2.Cells(i, "B").value = FinalResult 'write the result of the vlookup finding
Next i 'check next row (go to next lookup value)
End Sub
If the vlookup function can't match a value in the table it will give you an error. I usually fix it dirty by wrapping the function in a error handling line and you need to clear the FinalResult value for each iteration, i.e.:
For i = 2 To EndRow
FinalResult = "" 'To clear previous value from loop iteration
Lookup_val = Sheet2.Cells(i, "A").value
On Error Resume Next 'ignore error if no value found
FinalResult = Application.WorksheetFunction.VLookup(Lookup_val, tbl, 4, False)
On Error GoTo 0 'continue loop anyway
Sheet2.Cells(i, "B").value = FinalResult
Next i
Currently, I'm trying to figure a way to look down a single column to find a specific criterion and in this case, I want to find dates that are less than 4/16/20. Once that criteria is met, I want to SUM the cell below for all met criteria in that column. This is an image of my dataset
.
After doing some googling the closest I found was the code below which leads me to the idea that change information after offset to compute what I want.
Using "If cell contains" in VBA excel
Sub AddDashes()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("RANGE TO SEARCH")
For Each cel In SrchRng
If InStr(1, cel.Value, "TOTAL") > 0 Then
cel.Offset(1, 0).Value = "-"
End If
Next cel
End Sub
Not sure if I'm on the right track. It would also be nice If I would be able to amend code to check a range vs 1 column, thanks.
In this example you need to select the range of dates (1 row at a time only) to run the code. This also allows you to input the date (I'm assuming it changes over time so this should be helpful)
Sub SumByDate()
Dim DateRange As Range
Dim c As Range
Dim d As Range
Dim SearchDateInput As String
Dim SearchDate As Date
Set DateRange = Application.InputBox("Select a range", "Get Range", Type:=8) 'Select Date Range
SearchDateInput = Application.InputBox("Enter A Date") 'enter as mm/dd/yyyy
SearchDate = DateValue(SearchDateInput) 'this converts date entered as string to date format
For Each c In SrchRng 'for each date in list of dates
Set d = c.Offset(1, 0) 'pionts out cells to sum- in this case the cell beneath the date
If c < SearchDate Then 'if date is less than input date
Sum = Sum + d 'sum the date if true
End If
Next c 'goes to next date in row
DateRange.Cells(1, 1).Offset(2, -1) = Sum 'inputs all summed values into cell that is two down, one to the left of first date cell
End Sub
Sub SumByDate()
Dim SrchRng As Range
Dim c As Range
Dim d As Range
Dim lCol As Long
Dim ColLtr As String
Dim SearchDate As Date
lCol = Cells(2, Columns.Count).End(xlToLeft).Column
ColLtr = Split(Cells(1, lCol).Address, "$")(1)
Set SrchRng = Range("B2:" & ColLtr & "2")
SearchDate = DateValue("04/16/2020")
For Each c In SrchRng
Set d = c.Offset(1, 0)
If c < SearchDate Then
Sum = Sum + d
End If
Next c
Range("A4") = Sum
End Sub
I've written a loop that runs through a range containing month names and to trim any that are greater than three characters as I only need to see the first three ie: Jan instead of January.
The code below works in identifying the cells that contain the longer names but the LEFT function clears the cell rather than just removing the excess characters to show the first three only. Any idea what is amiss in the function? Help is much appreciated.
Many thanks.
Sub TrimMonth()
Application.ScreenUpdating = "False"
Dim rng As Range
Dim i, counter As Integer
Dim lastrow As Long
lastrow = ActiveSheet.Range("A1048576").End(xlUp).row
'Set the range to evaluate.
Set rng = Range("A2:A" & lastrow)
'initialize i to 1
i = 1
'Loop for a count of 1 to the number of rows in
'the range to evaluate.
For counter = 1 To rng.Rows.Count
'If cell i in the range contains more than 3
'characters then trim to 3 characters else increment i
If Len(rng.Cells(i)) > 3 Then
rng.Cells(i).Value = Left(Cells(i).Value, 3)
i = i + 1
Else
i = i + 1
End If
Next
Application.ScreenUpdating = "True"
End Sub
This code adds a formula to column B to return the three letter month text, then copies the values to column A before deleting the formula.
Sub TrimMonth()
Dim rDates As Range
With ThisWorkbook.Worksheets("Sheet1")
'Set reference to range containing month names.
Set rDates = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
'Add formula one column to right.
'This will convert the month name to a real date and then format it
'as three letter month text.
rDates.Offset(, 1).FormulaR1C1 = _
"=TEXT(DATEVALUE(""1-"" & RC[-1]),""mmm"")"
'Replace originals with values from formula.
rDates.Value = rDates.Offset(, 1).Value
'Clear formula.
rDates.Offset(, 1).ClearContents
End With
End Sub
Or to do it without adding the formula:
Sub TrimMonth()
Dim rDates As Range
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet1")
'Set reference to range containing month names.
Set rDates = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
'Convert each cell in range.
For Each rCell In rDates
rCell.Value = Format(CDate("1-" & rCell), "mmm")
Next rCell
End With
End Sub
My intention was to have the following code compile data from my "Low CPM 1" worksheet into an array and then filter my active worksheet based on this array. While the macro does seem to affect the filters, none of the values get filtered out. Any help on this matter would be greatly appreciated
Sub Macro1()
Dim CPM1Array(0 To 300) As Variant
For i = 2 To UBound(CPM1Array)
CPM1Array(i) = Sheets("Low CPM 1").Cells(i, 2).Value
Next i
ActiveSheet.Range("$A$1:$H$251").AutoFilter Field:=3, Criteria1:=("<>1 to Ubound(CPM1Array)"), Operator:=xlFilterValues
End Sub
There is no simple way with autofilter to achieve what you want. You cannot use Criteria1:="<>MyArray"
Alternative
We know which values we do not want. We can find out what are the values of the relevant column
Simply store the values of the relevant column in an array and then remove the unnecessary values from it by comparing it with the array which has values we do not want.
Remove blank cells from the array
Pass the final array to the autofilter.
In Action
Let's say our worksheet looks like as shown in the below image. I am taking an example of only 15 rows.
Code
Sub Sample()
Dim ws As Worksheet
Dim MyAr(1 To 5) As String
Dim tmpAr As Variant, ArFinal() As String
Dim LRow As Long
ReDim ArFinal(0 To 0)
Set ws = ActiveSheet
'~~> Creating an array of values which we do not want
For i = 1 To 5
MyAr(i) = i
Next i
With ws
'~~> Last Row of Col C sice you will filter on 3rd column
LRow = .Range("C" & .Rows.Count).End(xlUp).Row
'~~> Storing the values form C in the array
tmpAr = .Range("C2:C" & LRow).Value
'~~> Compare and remove values which we do not want
For i = 1 To LRow - 1
For j = 1 To UBound(MyAr)
If tmpAr(i, 1) = MyAr(j) Then tmpAr(i, 1) = ""
Next j
Next i
'~~> Remove blank cells from the array by copying them to a new array
For i = LBound(tmpAr) To UBound(tmpAr)
If tmpAr(i, 1) <> "" Then
ArFinal(UBound(ArFinal)) = tmpAr(i, 1)
ReDim Preserve ArFinal(0 To UBound(ArFinal) + 1)
End If
Next i
'~~> Filter on values which you want. Change range as applicable
.Range("$A$1:$H$15").AutoFilter Field:=3, Criteria1:=ArFinal, Operator:=xlFilterValues
End With
End Sub
Output