I search a good way to check if one date is present into one array.
I'm able to chech if a string is in to an array but I can't modify the cose to use it with date.
Dim datatest as date
Dim arfest As Variant
UR = Sheets("Fest").Cells(Rows.Count, 1).End(xlUp).Row
arfest = Sheets("Fest").Range("A2:A" & UR) 'A2=1/1/2015,A3=5/2/2015,A4=8/5/2015,.....
datatest= 5/2/2015
if instr(1, datatest, arfest,1) then ..
result: Error run-time '13', type not corresponding
what wrong?!?!
3 points here:
When you read worksheet cells into a variant, if you don't specify the property (ie Text, Value or Value2), the default is .Value. This is always a bit risky with dates as you can't be sure about date formats. I find it easier to work with Excel's date values (which are Long and therefore not susceptible to formatting problems). You might therefore be better off specifying .Value2.
The variant array needs to be interrogated in a loop, ie checking each element of the array. So your Instr function won't work, as this checks a String.
If you decide to compare date values instead of the strings or dates themselves, the use DateValue() to convert a date to its Excel value and CDate to convert the value to a date.
You might consider rewriting your code as follows:
Dim datetest As Long
Dim arfest As Variant
Dim UR As Range
Dim i As Long
' Read the values into the variant array
With ThisWorkbook.Worksheets("Fest")
Set UR = .Cells(.Rows.Count, "A").End(xlUp)
arfest = .Range("A1", UR).Value2
End With
datetest = DateValue(DateSerial(Year:=2015, Month:=2, Day:=5))
'Loop through the array, checking each date value
For i = 1 To UBound(arfest, 1)
If arfest(i, 1) = datetest Then
MsgBox DateValue(CDate(arfest(i, 1)))
End If
Next
I've changed way with a loop, if I find the date into array, I add one day..
For Each i In arfest
If datatest = i Then datatest= DateAdd("d", 1, datatest)
Next i
forgive the hasty ask
Related
I am crunching numbers with VBA in Excel using data imported from a text file. The timestamp data is in the form, "dd-mmm-yyyy hh:mm:ss.000", and the number format is set to "dd-mmm-yyyy hh:mm:ss.000" for the whole column. After import, the imported column matches the text file exactly (e.g., 16-Mar-2020 16:10:15.175).
As part of the number-crunching, I read the imported column into a variant array called timestamp:
Dim timestamp As Variant
timestamp = Range(.Cells(1, Timestamp_Column), .Cells(NumRows, Timestamp_Column))
When I examine the data with a breakpoint, it is formatted as a date, but no timestamp is visible. It is formatted as: #16-Mar-20 4:10:15 PM#
I then paste it into a destination sheet that has the same number format assigned as the original data:
Private Function FillColumnData(theArray As Variant, transpose As Boolean, _
sheetname As String, destCol As Integer) As Variant
Dim destColRange As Range
Dim tempArray as Variant
Dim maxrow As Long
maxrow = NumRows()
' Transpose the array?
If (transpose) Then
tempArray = TransposeArray(theArray) ' Transpose the array
Else
tempArray = theArray ' The timestamp array is not transposed
End If
With Sheets(sheetname)
Set destColRange = .Columns(destCol)
Set destColRange = destColRange.resize(maxrow, 1)
destColRange.value = tempArray
End With
The resulting column is complete and matches the original column data, except all the millisecond values are 0: e.g., original = "16-Mar-2020 16:10:15.175"; copy = "16-Mar-2020 16:10:15.000".
Is there something I could force when pasting the array back to the destination sheet?
Thanks in advance for any help!
Passing dates to/from VBA/worksheet is sometimes tricky. Excel stores dates as serial numbers with 1 = 1-Jan-1900. VBA as an explicit Date data type.
Easiest would be to replace your assignment statement with:
timestamp = Range(.Cells(1, Timestamp_Column), .Cells(NumRows, Timestamp_Column)).Value2
That way you are passing a Double rather than a Date data type.
An alternative would be to loop through your timestamp array, replacing each element with CDbl(timestamp(x,y)), but it seems more efficient to access that value directly using the Value2 property.
That will provide the unformatted value and include the milliseconds
Proof of Concept Code
Option Explicit
Sub dtStuff()
Dim R As Range: Set R = Range("A1:a2")
Dim v, w
v = R
w = R.Value2
With R.Offset(0, 1)
.NumberFormat = R.NumberFormat
.Value = v
End With
With R.Offset(0, 2)
.NumberFormat = R.NumberFormat
.Value = w
End With
End Sub
I have a 2D array and have to print parts of it to a sheet,
when I do print it to a sheet most dates appear exactly as they do in the locals window.
Some of them don't instead appearing as US Date
Sub ConvertDates()
With Range("G1:G76")
.NumberFormat = "dd/mm/yyyy"
.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False,
_
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
End With
End Sub
If I change the format inside of excel it just rearranges the date into the UK format but the date is wrong.
EG 11/06/2019 is transposed from the array as 06/11/2019
but 13/06/2019 is transposed from the array as 13/06/2019 as it should be.
Reformatting the cell inside excel has zero effect, it just changes the format
of the date it already decides is correct in the US format.
IF i run VBA code to change the format, it accepts the reformat and now displays the correct date. WTF?? See Convertdates()
BUT, if I alter the convertdates() code to numberformat = "dd/mm/yyyy"
it will display the incorrect date??
if you need the array code I can show it, but this is bizarre.
the dates this anomaly occurs with are 10,11,12 out of a possible range of
10,11,12,13,14,15,16
Yes I know your frustration with this. The workaround I found is below. I stored dates from a range to my array iArray. When outputing them to a specified range use the below.
Sheet1.Cells(myRow, myCol).Value = Format$(iArray(aRow, aCol), "\ dd\/mm\/yyyy\")
Additionally you would need to run an adaptation of the below to clean after. The above will keep a space in the front of the date and for some reason when you run VBA on that date it changes back to US.
Sub CleanDates()
'excel converting uk dates to us after performing action on it with VBA
Dim strDate As String, strTrim As String
Dim dRng As Range, dCol As Long, lRow As Long
Dim i As Long, j As Long
Set dRng = wsU.Rows(1).Find(What:="Start Dates", LookAt:=xlWhole)
If Not dRng Is Nothing Then
dCol = dRng.Column
Else
MsgBox "Failed to find the date columns to clean dates. Please consult the developer.", vbCritical
Exit Sub
End If
lRow = wsU.UsedRange.Rows.Count
For i = 2 To lRow
For j = dCol To (dCol + 1)
strDate = wsU.Cells(i, j).Text
strTrim = Right(strDate, Len(strDate) - 1)
wsU.Cells(i, j).Value = DateSerial(Year(strTrim), Month(strTrim), Day(strTrim))
Next j
Next i
End Sub
Hope it helps with your issue.
I have a simple macro that includes a dynamic array which fills up upon conditions are met. The data populates the macro as it is supposed to be functioning until it paste the data onto the spreadsheet. Now, all data is pasted correctly except for date values. Date values are pasted erroneously from European format to American format onto the spreadsheet (i.e. dd-mm-yyyy to mm-dd-yyyy). So for instance a 1st march 2019 becomes a 3rd January 2019 on the spreadsheet. Note that either I format beforehand the destination files or not, the problem still occurs.
The array has 14 columns and only column 12-13 are date values.
Edit Summary
Shredded the code from irrelevant information; added images of results.
Following is the code
Sub Verification()
Dim NewWorkbook As String, NewWorksheet As String
Dim wb As Workbook, sh As Worksheet
Dim LoopCounter As Long
Dim NewEntryCounter As Long
Dim Cols As Long, Rows As Long
Dim r As Range
Dim arr As Variant, NewEntry() As Variant
Dim myRange As Integer
NewWorkbook = LCase(InputBox("What is the name of the new report?"))
NewWorksheet = LCase(InputBox("What is the name of the sheet?"))
Set wb = ThisWorkbook
Set sh = wb.Sheets("Renouvellement")
Cols = Workbooks(NewWorkbook).Sheets(NewWorksheet).Range(Workbooks(NewWorkbook).Sheets(NewWorksheet).Cells(1, 1), Workbooks(NewWorkbook).Sheets(NewWorksheet).Cells(1, 1).End(xlToRight)).Count
Rows = sh.Range(sh.Cells(1, 1), sh.Cells(1, 1).End(xlDown)).Count
For Each r In Workbooks(NewWorkbook).Sheets(NewWorksheet).Range("A2", Workbooks(NewWorkbook).Sheets(NewWorksheet).Range("A1").End(xlDown))
If (r.Offset(0, 21).Text = "Red" Or r.Offset(0, 21).Text = "Blue") And r.Offset(0, 17).Value >= 24 Then
arr = Application.VLookup(r.Value, sh.Range("A:A"), 1, 0)
If IsError(arr) Then
NewEntryCounter = NewEntryCounter + 1
ReDim Preserve NewEntry(1 To Cols, 1 To NewEntryCounter)
For LoopCounter = 1 To Cols
NewEntry(LoopCounter, NewEntryCounter) = r.Offset(0, LoopCounter - 1)
Next LoopCounter
Else
End Sub
Sample results from Local window
Sample results when transferring date values onto spreadsheet
As you can see the first value inserted is changed when transferring data from vba to spreadsheet. The second value is correctly transferred. The third is not, and so on.
Again, it's a bit difficult for me to understand exactly what you're doing, but it seems that a filter might be simpler, so far as the copying of relevant data is concerned.
In your code, you are making multiple calls to the worksheet, and multiple Redim Preserve operations on the VBA array. Those operations can be costly.
Perhaps that part of the code could be simplified (and sped up) with something like (obviously, you may need to change the worksheet and range variables):
Set ws = Worksheets("sheet1")
Set r = ws.Range("a1").CurrentRegion
With r
.AutoFilter field:=22, Criteria1:="red", Operator:=xlOr, Criteria2:="blue"
.AutoFilter field:=18, Criteria1:=">=24"
End With
r.SpecialCells(xlCellTypeVisible).Copy
'Paste somewhere
ws.ShowAllData
I have a table of monthly sales figures - FreqData1. Each column represents a month and is numbered 1 to 12. The user chooses one of these numbers from a dropdown list.
I have the code to find the column number and I have tried to assign the data in that column to an array so I can use it copy it to a different spreadsheet but with my basic VBA knowledge and despite lots of searching I have been unable to find the code as to how to do this or a different method to carry this out.
Can anyone help please
Sub AnnualFreqMacro()
Dim TPNoInt As Long, BranchNoInt As Long, ColNo As Long
Dim FreqArray()
Worksheets("Freq data").Activate
TPNoInt = Range("B42").Value
BranchNoInt = Range("B41").Value
ColNo = Application.Match(TPNoInt, Range("TPBr1"), 0)
CharaArray = Range("FreqData1").Cells (1, ColNo), Cells(16, ColNo))
End Sub
Many thanks in advance
I think this is your answer: It's how you're using the range.
Delete your CharArray = ... line and replace with:
With Range("FreqData1")
CharaArray = .Range(.Cells(1, ColNo), .Cells(16, ColNo))
End With
The issue is how you're setting the range, Range().Cells(), Cells() isn't the context, you'd want something more like Range(Cells(),Cells()).
Let's say "FreqData1" is the range A10:A20. If you use
With Range("FreqData1")
.Cells(1,1).Select
End With
this will select the top left most cell (row 1, column 1) in the range "FreqData", so cell A10 would be selected.
A final misc. point: Avoid using .Select/.Activate. You can activate a sheet of course so you can follow your macro, but when setting variables to ranges/cell values, etc. it's best to qualify which sheet you are referring to.
Sub AnnualFreqMacro()
Dim TPNoInt As Long, BranchNoInt As Long, ColNo As Long
Dim FreqArray()
Dim freqWS As Worksheet
Set freqWS = Worksheets("Freq data")
' Worksheets("Freq data").Activate ' removed this, since we have a variable for it now.
TPNoInt = freqWS.Range("B42").Value ' see how I added the worksheet that we want to get B42's value from?
BranchNoInt = freqWS.Range("B41").Value
ColNo = Application.Match(TPNoInt, Range("TPBr1"), 0)
With freqWS.Range("FreqData1") ' I'm assuming "FreqData1" is on this worksheet
CharaArray = .Range(.Cells(1, ColNo), .Cells(16, ColNo))
End With
End Sub
I'm not positive if you have to qualify a named range's sheet, since it's a named range, but I added that just to be safe.
Edit2: Hm, oddly enough, if your named range "myRange" is A1:A10, you can still do myRange.Range(myRange.cells(1,1),myRange.cells(1,2)), even though there's no second column in the range, it just expands it. I thought it'd throw an error, but nope. Just to note.
I have a list of customers from last year (in column A) and I have a list of customers from this year (in Column B). I've put the data from these two columns in arrays (using the code below - which is set up as Option Base 1):
'Define our variables and array types'
Sub CustomerArray()
Dim LastArray() As String
Dim CurrentArray() As String
Dim BothArray() As String
Dim LR As Long
Dim i As Integer
'Define LastArray which is customers last year'
LR = Cells(Rows.Count, 1).End(xlUp).Row
ReDim LastArray(LR - 3)
With Range("A1")
For i = 1 To LR - 3
LastArray(i) = .Offset(i, 0)
Next i
End With
'Define CurrentArray which is customers this year'
ReDim CurrentArray(LR - 3)
With Range("B1")
For i = 1 To LR - 3
CurrentArray(i) = .Offset(i, 0)
Next i
End With
End Sub
Now I want to compare/combine the Arrays to show a list of customers who appear in both of the two arrays I just defined (last year and this year). I want to create a third array with the customers who appear for both years (and I want to put that in column D of my excel sheet). I'm getting confused on how to write the code which will compare these two arrays (current year and last year). Will I use a conditional If > statement? Each of the arrays have the customers listed alphabetically.
I appreicate any help you might be able to give me.
Thanks!
You don't need to mess with arrays or loop at all, keep it simple, try something like this:
Sub HTH()
With Range("A1", Cells(Rows.Count, "A").End(xlUp)).Offset(, 3)
.Formula = "=IF(COUNTIF(B:B,A1)>0,A1,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).Delete
End With
End Sub
OK. I got a little carried away here, but this does what your are asking (you may have to tune it up to suit your specific needs. To use this code, simply call the Sub "Match Customers".
Your original code proposed the use of three arrays. Excel VBA provides some mechanisms to do what you seek which are both easier to use, and possibly more efficient.
I went ahead and broke the process out into more discrete chunks of code. While it seems like more code, you will find that each peice might make more sense, and it is much more maintainable. You can also now re-use the individual functions for other operations if needed.
I also pulled your range and column indexes out into locally defined constants. This way, if the various row or column references ever need to change, you only have to change the value in one place.
It is not necessarily the most efficient way to do this, but is most likely less complicated than using the arrays you originally propose.
I have not tested this exhaustively, but it works in the most basic sense. Let me know if you have questions.
Hope that helps . . .
Option Explicit
'Set your Column indexes as constants, and use the constants in your code.
'This will be much more maintainable in the long run:
Private Const LY_CUSTOMER_COLUMN As Integer = 1
Private Const CY_CUSTOMER_COLUMN As Integer = 2
Private Const MATCHED_CUSTOMER_COLUMN As Integer = 4
Private Const OUTPUT_TARGET As String = "D1"
Private Const LAST_ROW_OFFSET As Integer = -3
'A Function which returns the list of customers from last year
'as a Range object:
Function CustomersLastYear() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, LY_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing last year's customers:
Set CustomersLastYear = Range(Cells(1, LY_CUSTOMER_COLUMN), LastCell)
End Function
'A Function which returns the list of customers from this year
'as a Range object:
Function CustomersThisYear() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, CY_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing this year's customers:
Set CustomersThisYear = Range(Cells(1, CY_CUSTOMER_COLUMN), LastCell)
End Function
'A function which returns a range object representing the
'current list of matched customers (Mostly so you can clear it
'before re-populating it with a new set of matches):
Function CurrentMatchedCustomersRange() As Range
Dim LastCell As Range
'Find the last cell in the column:
Set LastCell = Cells(Rows.Count, MATCHED_CUSTOMER_COLUMN).End(xlUp)
'Return the range of cells containing currently matched customers:
Set CurrentMatchedCustomersRange = Range(Cells(1, MATCHED_CUSTOMER_COLUMN), LastCell)
End Function
'A Function which performs a comparison between two ranges
'and returns a Collection containing the matching cells:
Function MatchedCustomers(ByVal LastYearCustomers As Range, ByVal ThisYearCustomers As Range) As Collection
Dim output As Collection
'A variable to iterate over a collection of cell ranges:
Dim CustomerCell As Range
'Initialize the collection object:
Set output = New Collection
'Iterate over the collection of cells containing last year's customers:
For Each CustomerCell In LastYearCustomers.Cells
Dim MatchedCustomer As Range
'Set the variable to reference the current cell object:
Set MatchedCustomer = ThisYearCustomers.Find(CustomerCell.Text)
'Test for a Match:
If Not MatchedCustomer Is Nothing Then
'If found, add to the output collection:
output.Add MatchedCustomer
End If
'Kill the iterator variable for the next iteration:
Set MatchedCustomer = Nothing
Next
'Return a collection of the matches found:
Set MatchedCustomers = output
End Function
Sub MatchCustomers()
Dim LastYearCustomers As Range
Dim ThisYearCustomers As Range
Dim MatchedCustomers As Collection
Dim MatchedCustomer As Range
'Clear out the destination column using the local function:
Set MatchedCustomer = Me.CurrentMatchedCustomersRange
MatchedCustomer.Clear
Set MatchedCustomer = Nothing
'Use local functions to retrieve ranges:
Set LastYearCustomers = Me.CustomersLastYear
Set ThisYearCustomers = Me.CustomersThisYear
'Use local function to preform the matching operation and return a collection
'of cell ranges representing matched customers. Pass the ranges of last year and this year
'customers in as Arguments:
Set MatchedCustomers = Me.MatchedCustomers(LastYearCustomers, ThisYearCustomers)
Dim Destination As Range
'Use the local constant to set the initial output target cell:
Set Destination = Range(OUTPUT_TARGET)
'Itereate over the collection and paste the matches into the output cell:
For Each MatchedCustomer In MatchedCustomers
MatchedCustomer.Copy Destination
'Increment the output row index after each paste operation:
Set Destination = Destination.Offset(1)
Next
End Sub
If you want to compare the two arrays using loops, maybe because you have, for example, picked up all the data into arrays for faster computation rather than interacting with the spreadsheet range object, or you need to compare multiple things from the two arrays to check that the entries match so can't use a .find statement, then this is what you need:
-Two loops, one nested inside the other
-Three counters, one for each array
-One "Exit Loop", "Exit For", "GoTo foundmatch" or similar way of exiting the inner loop
-A "Redim Preserve" of the results array
-An "If" statement
-Finally, one line where you assign the name that appears in both arrays to the results array
This is everything that is needed to write it simply as loops - but doesn't give the fastest or best way to do it (Redim Preserve is not the best..). Constructing it should be easy from this list though: the if statement should either be an x=y type for a general usage, or if x>y if you are really really sure that the list being looped in the inner loop really is sorted alphabetically