Setting number format using Excel object quickly - vba

I am writing 12,000 records with 46 columns, as a production report, to an excel file. The worksheet is not displayed while it is filled with data.
Previous StackOverflow information taught me to use arrays of objects to put values in ranges for speed. I had hoped this worked for formatting the values as well.
Code snip:
objExcel.Calculation = XlCalculation.xlCalculationManual
objExcel.ScreenUpdating = False
dcel = objWS.Range(objWS.Cells(rowdatastart, 1), objWS.Cells(rowdataend, nProdReportCol.ProdReportColCount - 2))
dcel.Value = aobj
dcel.NumberFormat = bobj
objExcel.ScreenUpdating = True
objExcel.Calculation = XlCalculation.xlCalculationAutomatic
aobj and bobj are object(,) arrays that fit the range. bobj contains strings such as "h:mma/p" to display time as "12:23a", and "0.00" to show numbers as "53/25".
The "dcel.value = aobj" takes half a second.
The "dcel.NumberFormat = bobj" takes 38 seconds.
Any suggestion for what I've missed/misunderstood? I'd rather a 7 second report (start excel, write, save, close excel) not take 45 seconds because I want the numbers/dates/times to appear as I choose.

If each column has its own format then try formatting per whole column. Also for each column do not use an array, if the formats are identical then you can just use a single string.
Do so for each column.
Please attempt and provide feedback.

After some more experimentation, I found the same solution as S Meaden. As only 14 of the 46 columns are not "General", I collected the column numbers for dates, times and 2-decimal numeric. Looping through each of these, gen a range for the 12000 records and 1 column, set the format. This takes about half a second for all the columns.
Odd that setting a row of 46 cells using a 46 object array takes so much longer than 12000 cells in a column, but there you are.
Thanks everyone.

Related

Python 3 copy data as is with xlrd and xlwt

I'm new to programming, teaching myself Python3. Wife asked me to make her a script that will read data from excel, from one column, and copy every other row into another column.
She has an excel of 12k rows and it's in form of: row1=string, row2=(int/float/date/time), row3=string, row4=(int/float/date/time)...
what i did is this:
import xlrd
import xlwt
workbook = xlrd.open_workbook("MyExcel.xls")
sheet = workbook.sheet_by_index(0)
wb = xlwt.Workbook()
ws = wb.add_sheet("Sheet1")
i = 0
data = []
for i in range(sheet.nrows):
if i % 2 == 0:
value = sheet.cell(i, 0).value
data.append(value)
j = 0
for j in range(len(data)):
ws.write(j, 0, data[j])
j += 1
wb.save("MyOutput.xls")
It works fine, but the issue is that it works fine with strings and integers, not with dates or time, it converts those into floats.
I just need it to copy the value of each cell "as is" no formatting or anything, just copy paste. If a cell has a value of: "monkey/73.0:blah" i just want it to copy it as "monkey/73.0:blah" into the new excel.
Any idea how to achieve this?
ps: I know it can be achieved within excel itself, without using python(with INDEX and ROWS), but i'm curious as to how to transfer data in this way as normal copy paste, without it for example dividing my dates into a float if its 1/1/2016.
Thx
You can't do exactly what you want to, because you don't understand what Excel stores in the file.
Dates and times are stored as floating-point values. Time values are between 0 and 1.0, and date/time values are stored as larger numbers (negative dates are not handled correctly by many versions of Excel). You can't just copy the cell values "as-is" (i.e., without formatting) because formatting is the only way a cell is known to be a date or time!
To read the dates & times, you could replace your block of code that builds the data list with this:
cv = lambda v, t: (v if t != 3
else datetime(*(xlrd.xldate_as_tuple(v, workbook.datemode))))
data = [ cv(sheet.cell(i, 0).value, sheet.cell_type(i, 0))
for i in range(1, sheet.nrows, 2) ]
This will give you a list of string, float, and datetime objects you can write to your output file (writing dates using xlrw is left as an exercise for the reader because I haven't done it, and it's late here & now).

How does one subtract the .Value from the Offset.Value of any given 'i' in a For Each loop?

I have the following code written in VBA:
For Each W In Range("B5:B15000").Cells
If W.Offset(-1, 0).Value - W.Value > 1.5 Then
W.Offset(-1, 0).EntireRow.Delete
End If
Next W
The intent is to iterate down 'Column B', between Rows 5 and 15000, subtracting each of the current 'W' values from the Offset 'W' values. If the resultant difference from the equation is greater than 1.5 then delete the entire following 'W'(Offset) row. If the difference is less than or equal to 1.5, move on to the next 'W'.
For a better understanding of the data set, column B is essentially a time stamp series. As you go further down the column, the time stamp increases in varying amounts of seconds. I need to pick out the gaps (so to speak) that are greater than 1.5 seconds and delete them.
Here is a sample of the column data:
The task seems simple enough, but I am receiving a 'Type Mismatch' error. I am relatively new to the For Each loop, so I do not quite understand what portions are mismatched.
The formats are definitely numbers, so you shouldn't get a type mismatch. My guess is row 5 is the first row which contains data so offsetting by -1 to row 4 causes the error because you cannot subtract a string (the header text) and number.
This aside, your logic of going top down could present a problem (in addition the implementation problem of deletion of the iterator, W, modifying the collection). Consider this data:
12
13
15
16
17
Going top down would delete row 3 and then compare row 4 to row 2 (since 3 was deleted) and delete it is well since the difference is larger than 1.5 (and so on).
Instead you will want to go bottom up. In the above example, row 5 and row 4 would remain because they would be compared with respect to their intended value with row 3 still being deleted.
The code for that could look something like this:
Dim i As Long
For i = 15000 to 6 Step -1 '6 because 6-1 would mean 5 is the first row which contains data.
If Cells(i - 1, "B").Value - Cells(i, "B").Value > 1.5 Then
Rows(i).Delete
End If
Next
Edit: Going bottom up is still going to leave large gaps in your data. For example in your provided data the following (among others) would be deleted:
50
31
23
A Type Mismatch error is due to a value that isn't the type you think it is. Most likely, one of the cells is blank, or contains text, or something that's not a number.
Explicit conversion to a Double with CDbl will likely not fix the Type Mismatch error, because if either value is not a number, things go boom anyway - implicit conversion or not.
The right thing to do is to handle all the edge cases - you need to decide how to handle values that are not a number - here's a function that treats them as 0:
Private Function GetNumericValue(rng As Range) As Double
Dim result As Double
On Error Resume Next
result = CDbl(rng.Value)
If Err.Number <> 0 Then result = 0
On Error GoTo 0
GetNumericValue = result
End Function
Now you can do this:
If GetNumericValue(W.Offset(-1, 0)) - GetNumericValue(W.Value) > 1.5 Then
If that still doesn't fix it, and your data is completely made of what appears to be numbers, then my bet is on the decimal separator character being off. Verify that in Control Panel / Regional Settings. Your spreadsheet seems to be expecting a dot, but your settings might have it as a comma.

How to Find the Length of a Column in VBA with a Variable Last Row

I'm a beginner to vba and hope to use it in order to automate a process. I have a computer program that provides me an excel spreadsheet, where the amount of data in the columns can change. For example, I could have a column of length 9 one time:
1
3
2
4
24
23
432
55
2
Or a column of length 5 (note: actual column sizes are usually in the thousands):
1
2
3
4
8
I want to write code that will grab this column, not knowing how long the column will be. Something like:
Dim list1 As Array
'I don't know how to find the upper bound
list1 = Range("A1:A" & Upper Bound).Value
Any help is appreciated. Thanks!
If you are working with constant values in these columns and are working with larger amounts of cells in these columns, it could be useful to use the count function:
dim x As Long
x = Worksheets(*sheet name*).Range(*column range*).Cells.SpecialCells(xlCellTypeConstants).Count
x is being passed the number of non-empty cells in your column. So you may want to be careful in your column range not to include any headers, if applicable.
I believe this will get you the last row. You might need to be careful if you're looking to count all values (e.g. the first couple rows are blank).
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
To get the data from column A into a 2d variant array, use the following:
Dim vA As Variant
vA = [a1:index(a:a,counta(a:a))]
This assumes that there are no blank cells within the data, and that the data starts in row 1.

VBA - draw in numbers from one sheet and get data from another

I am trying to write a VBA to draw data from one sheet to another, but am stuck on something.
I only need some of the data in the original sheet (let's call it s1), in particular, I need data between two rows.
I have these rows written down in another sheet (s2), so I know exactly between which rows I need the data from. As you may expect there are multiple rows between which I need the data.
The problem is now that I am trying to write a VBA that is able to look up these rows in my row sheet (s2), and then goes to the sheet in which all my original data is contained (s1), and then draws out the data between the two rows into a third sheet (s3).
I have not been able to make it draw in the numbers from s2 (can't seem to work out how to tell it that it is these two rows between which I need the data, but from another sheet), and currently have to input the row numbers myself, which is really tedious, since the dataset is large!
Any help would be much appreciated!
Thank you!
Have you tried the .find option.
You could use something like this:
findrow = w1.Cells.Find(what:="Content", MatchCase:=False).Row
An more extensive example would help
Just break down your problem into smaller steps.
You can assign a value on a sheet using cell references:
Sheets("S1").Cells(iRow, iCol) = Value
'or
Sheets("S3").Cells(2, 10) = Sheets("S2").Cells(2, 10)
You can use Sheets("S1").Range("J" & iRow) or Range("J2").
If there are conditions that need to be met for something to happen, use If statements.
If (Value 1 < Value 2) Then
Sheets("S3").Cells(2, 10) = Sheets("S2").Cells(2, 10)
Else
Sheets("S3").Cells(2, 10) = Sheets("S1").Cells(2, 10)
End If
Without more information about the specific choices you are using to determine which rows to copy and from which sheet, it's hard to say. But you can do things in smaller batches or copy whole ranges, by looping.
Dim iRow As Integer
'This would copy all the data from Sheet("S1").Range("J1:J20) to Sheet "S3".
For iRow = 1 to 20
Sheets("S3").Cells(iRow, 10) = Sheets("S1").Cells(iRow, 10)
Next iRow
You could insert an If statement into each row, inside the loop to see if a certain criteria is met, and then decide which sheet in which to copy the data.

Formula to work out whether all filled in fields are the same, but ignores those that aren't filled?

I'm trying to work a formula so that a cell reads "Days" if all of the filled in cells in a selection are equal, but ignoring those that equal 0 (or blank, whichever's easier).
I've got a start with all the fields I believe I need (don't have the rep for a screen shot but I'll try and explain)
The sheet is to work out holidays based on hours entered in the "hours" row, with Monday K16, Tuesday L16 etc.
The rows are labelled as follows: hours = manual entry, bank hols = bank holidays between two dates (elsewhere on sheet), hours in bank = total hours that would be worked on bank holidays, is a work day = if(hours="0","0","1").
The cell I want would be somewhere below these, but it wouldn't particularly matter as it will be hidden anyway.
Is there a way to work out whether all the values in the manual input "hours" are equal while ignoring all those in the range if they equal 0 (or are blank).
From this I am wanting to display "Days" if they are the same, else show "hours".
I'm also aware that this may require a bit of VBA which I'm currently looking at, but it'd still be nice to get some feedback on here.
Try this:
=IF(COUNTIF(A1:E1,AVERAGEIFS(A1:E1,A1:E1,">"&0))=COUNTIF(A1:E1,">"&0),COUNTIF(A1:E1,">"&0)&" Days",SUM(A1:E1)&" Hours")
Where the values are in A1:E1
EDIT: edited original formula, please use above corrected formula
Say we want to test A1 thru A13
=IF(SUMPRODUCT((A1:A13<>"")/COUNTIF(A1:A13,A1:A13&""))=1,"Days","Hours")
blanks will be ignored.
Assuming that you are only checking one linear set of data IE:
HRS = 1
Bank Holiday Hrs = 1
Hrs in Bank = 1
then you can try
=IF(MOD(SUM(A2:C2),2),"days","hours")
Where A2:C2 are your rows with the data.
If this requires a unique check of actual hrs then it wont work with any values other than 1 or 0 of course.