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
Related
I need to use values from several columns based on a row value. Is it better and faster to create variant matrix array and store all columns in that array then search and deploy values from that array, or create an array for each column, considering that there can be several thousand rows and the values are used multiple times?
Example: We have the following data:
If the person joined before 01-Jan-13, I want to deduct due amount from equity. Is it better to declare a variant array like
Dim matrix() as Variant
Dim ws as Worksheet
Dim cols(4) as String: cols(0) = "A': cols(1) = "B": cols(2) = "C": cols(3) = "D"
Dim i as Integer
Dim b as Integer: b = 2 'beginning row
Dim j as Integer: j = 4 'number of lines
Set ws = Worksheets("Sheet1")
For i = 0 to UBound(cols)
matrix(i) = Range(cols(i) & b & ":" & cols(i) & (b + j)).value2
End if
or
Declare separate four arrays, like
Dim arr1() as String
Dim arr2() as Date
Dim arr3() as Integer
Dim arr4() as Integer
Of course I can directly use data from cells by directly referencing cells as well, but as I use this multi-thousand-row data multiple times it makes more sense to store them in array.
If there are many columns, it may be noticeably faster to read all the data into a single matrix in one go. There is a large overhead with every transfer of data between Excel and VBA. A larger data transfer is not much slower than a small data transfer, but many data transfers is a lot slower than a single transfer.
Here is an excellent source of detail:
Data transfer between worksheet cells and VBA variables is an expensive operation that should be kept to a minimum. You can considerably increase the performance of your Excel application by passing arrays of data to the worksheet, and vice versa, in a single operation rather than one cell at a time. If you need to do extensive calculations on data in VBA, you should transfer all the values from the worksheet to an array, do the calculations on the array, and then, possibly, write the array back to the worksheet. This keeps the number of times data is transferred between the worksheet and VBA to a minimum. It is far more efficient to transfer one array of 100 values to the worksheet than to transfer 100 items at a time.
http://www.cpearson.com/excel/ArraysAndRanges.aspx
Copy a Range to an Array and Vice Versa
Option Explicit
Sub DeductDue()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
' Reference the data (no headers) range ('rg').
Dim rg As Range
With ws.Range("A1").CurrentRegion
Set rg = .Resize(.Rows.Count - 1).Offset(1)
End With
' Write the values from columns 2-4 ('Date' to 'Due') to an array ('sData').
Dim sData As Variant: sData = rg.Columns(2).Resize(, 3).Value
' Wrtie the values from column 6 ('Equity') column to an array ('dData').
Dim dData As Variant: dData = rg.Columns(6).Value
' Loop through the rows of the arrays and calculate...
Dim r As Long
For r = 1 To rg.Rows.Count
If Year(sData(r, 1)) < 2013 Then
dData(r, 1) = dData(r, 1) - sData(r, 3)
End If
Next r
' Write the result to a column range, e.g.:
rg.Columns(6).Value = dData ' overwrite Equity with the deducted values
End Sub
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 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
I have created an array as range of cells that contains numbers and text. One column is called PolicyNumber. There are values as:
11/2007
8/2006
12/2005
etc.
If I want to copy the cells from the array back to the sheet it returns not values 11/2007, 8/2006, 12/2005, etc, however it returns the result of calculation
11/2007 = 0.00548
8/2006 = 0.003988
12/2005 = 0.00598
etc.
I have tried
Formatted the values PolicyNumberas text before created the array;
Split the PolicyNumber onto two cells and than put them back;
When exported the values from the array used function format, cstr.
I hope that it is clear to understand the problem.
Assuming that the policynumber column is formatted as text, then formatting the output as text works for me:
Sub getit()
Dim var As Variant
var = Range("a1:A2")
Range("c1:c2").NumberFormat = "#"
Range("c1:c2") = var
End Sub
Sub firstcheck()
Dim X()
dim ind as Worksheet, FC as Worksheet
dim N as Double
Set ind = Sheets("Input Data")
Set FC - Sheets("First Check")
N = Application.CountA(Ind.Range("G:G"))
X = ind.Range("C2:T" & N).Value 'data
....
FC.Range("B2:S" & N) = X
End Sub
Column :
Policynumber:
Data that works ok :
99-155547/003
99-155690/003
99-155837/003
99-173341/003
99-185326/003
Copied some data that does not work:
2013/00176
2012/08233
2012/08016
2012/08330
2012/08749
2012/01122
I'm a bit new at this. How would I take the column and put the cell data of which is an integer and go through all values in that range to put it into a function to output the result into another column in the excel workbook. So my output column will be the entire Comm column using columns G, J and K for inputs into the function =100000*slotNumber+300*xpos+ypos
A B C D E F G H I J K
1 Proc Equip Operat Shift Comm Casette SlotNumber Diam Measure XPos YPos
2
3'
So thought if I took the values of each and made a for loop I could take the values and somehow do all this, just not sure how! Please and thank you!
EDIT: I have all columns stored, now I must pass the Array values into the function one by one, for the formula Z = 100000*slotArr(i)+300xList(i)+yList(i) or maybe I can just place it in the for loop.
EDIT: Having placed the function in the loop...I am getting an object out of range error...at the line of the function.
Sub cmdMeans_Click()
Dim i As Long, j As Long
Dim slotList As Range, slotArr() As Variant, xList As Range, xArr() As Variant
Dim yList As Range, yArr() As Variant, cArr() As Variant
Set slotList = Range("P2", Range("P2").End(xlDown))
slotArr() = slotList.Value
Set xList = slotList.Offset(0, 4)
xArr() = xList.Value
Set yList = slotList.Offset(0, 5)
yArr() = yList.Value
'Only one counter required because of the dependancy on the range slotList
For i = 2 To UBound(slotArr, 1)
'Dimensioning Array
ReDim cArr(UBound(slotArr, 1), 1)
cArr(i, 1) = (100000 * slotArr(i, 1)) + (300 * xList(i, 1)) + yList(i, 1)
'MsgBox ("Comment Cell Value" & cArr(i, 1))
Next
'Resizing Array
ReDim Preserve cArr(i)
'This is where the new values will be written to the comment column
Dim cRng As Range
Set cRng = Range(Cells(14, 1), Cells(UBound(cArr(i))))
cRng.Value = Application.Transpose(cArr)
End Sub
I get worried to look at your sample - appolgy but really not decipherable... So I stick with your question title and comment:
VBA Excel Store Range as Array, extract cell values for formula. Offset for other variables.
How store Range as Array:-
Dim vArray as Variant
vArray = Sheets(1).Range("A2:G50").Value)
How to pass array into a function that takes an array as a parameter and returns an array:-
Function passArray(ByRef vA as Variant) as Variant
Dim myProcessedArray as Variant
'----your code goes here
passArray = myProcessedArray
End Function
Output Single Dimensional array to worksheet Range:-
Sheets(1).Range("E2").Resize(1, _
UBound(Application.Transpose(singleDArray))) = singleDArray
Output Multi Dimensional array to worksheet Range:-
Sheets(1).Range("E2").Resize(UBound(multiDArray) + 1, _
UBound(Application.Transpose(multiDArray))) = multiDArray