I want to iterate over all rows of a MS-Word mail merge data source and extract the relevant data into an XML.
I'm currently using this code:
Imports Microsoft.Office.Interop
Do
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
If DataSource.ActiveRecord = LastRecord Then
Exit Do
Else
DataSource.ActiveRecord = Word.WdMailMergeActiveRecord.wdNextDataSourceRecord
End If
Loop
And it turns out to be a little sluggish (About 1 second for each row). Is there any way to do it faster?
My fantasy is finding a function like MailMergeDataSource.ToDatatable and then inspecting the datatable.
Any time you're iterating through something row by row, and then doing some kind of processing on each row, is going to get a little slow.
I would be inclined to approach this problem by having a step before this which prepared the mdictMergeFields collection so that it only contained elements that were not 'null or empty', this will mean you won't have to check for that on each iteration. You could do this in process, or 'sneakily' in the background while the user is doing something else.
The other thing to try (might help!) is to change the "Do... Loop" block so that you're not checking at the end of each imported row whether or the record is the 'last record'. Instead, get a count of the records, and then compare the current index to the knowm maximum (which might be quicker)
I.E.:
Dim i, x as Integer
i = ActiveDocument.MailMerge.DataSource.RecordCount
Do While x < i
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
x += 1
Loop
I don't really work with the Office Interop much, but hopefully this might offer some assistance! Post back, let me know how it goes.
/Richard.
Related
i have datatable "dataitems" contain 98000 Rows And Datagridview have 11000 row
want to add the quantity form the datatable to the datagridview every item in it's row in the datagrid view
i am using this code but its take too too too much time to run and sometimes stop responding i need ideas to make it faster to run
Dim dt As New DataTable = najrndataset.dataitems
Dim Total As Integer
for x = 0 to datagridview1.rows.count -1
Dim b = datagridview1.rows(x).cells(1)
Dim c = 3
Total = (From r As DataRow In dt.AsEnumerable
Where r.Field(Of String)("Item_Number") = b And r.Field(Of Integer)("SOP_Type") = c
Select r.Field(Of Integer)("Quantity")).Sum
datagridview1.Rows(x).Cells(0).Value = Total
next
Hopefully you appreciate that if you have 11000 rows in a datagridview (terrible idea, by the way) and 98000 rows in a datatable, and you're running a loop that searches the table for each of the 11K items, and it does this by starting at number 1, and searching 98000 items for it, then going to 2 and searching 98000 items for it til you reach 11000 and searching 98000 items for it... At the end of the operation you're going to have performed 11000 x 98000 operations.. i.e. you're going to have performed 1.078 BILLION operations. This is why "its take too too too much time to run and sometimes stop responding" :)
You can speed this up by using a dictionary to track the sums, and it'll probably be fastest to index the 98000 items then set the dictionary from them:
Dim d as New Dictionary(Of String, Integer)
For Each di In najrndataset.dataitems.Where(Function(r) r.SOP_Type = 3)
If Not d.ContainsKey(di.Item_Number) Then
d(di.Item_Number) = di.Quantity
Else
d(di.Item_Number) += di.Quantity
End If
Next di
Then edit your grid (ugh; this isn't how datagridview are supposed to be used)
datagridview1.SuspendDrawing()
For x = 0 to datagridview1.rows.count - 1
Dim b = datagridview1.rows(x).cells(1)
Dim s As Integer
If d.TryGetValue(b, s) Then
datagridview1.rows(x).cells(0) = s
End If
Next x
datagridview1.ResumeDrawing()
You could also have a logic of "loop over the datagrid, putting 11000 items in the dictionary, loop over the datatable accumulating sums into the dictionary if the keys are present in the dictionary, loop over the datagriview putting the sums into the datagridview".
Not an answer, but too long for a traditional comment. I'm working to provide an answer separately.
I can't tell you how many times I've seen code like this:
Dim someVariable As New SomeObject
someVariable = someMethodToReturnSomeObject()
This pattern is bad code!
The New operator in the first line tells the compiler you want to allocate memory and run the constructor for your type. However, the next line assigns a new object... it throws away and forgets the memory and constructor work from the previous line. That's wasteful.
Instead, you want this:
Dim someVariable As SomeObject = someMethodToReturnSomeObject()
Worse, this speaks to a profound lack of understanding of the difference between a reference and an object, and what the computer is doing with your code in memory. This is a core principle of how many programming environments work. Code like the first example gives me big doubts of the capability of the programmer who writes it.
I hope this is a simple question and you don't have to waste too much of you time on it.
I have an report (called repRAD78) which contains a textbox (called txtRAD8). I would like to populate txtRAD8 with a calculated value based on numbers pulled from a query called qryrRAD78.
Looking through the forums it looks like recordsets would be the solution but this is my first foray into recordsets and it's not going well. :(
The code I have pasted in below I have pulled together from a number of places and it doesn't produce any errors but puts the same value into txtRAD8 for all the records.
I'm sorry if this is a stupid question but it's been driving me potty.
Many thanks for your time.
Al.
Public Sub Calc()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryrRAD78")
rst.MoveFirst
Do Until rst.EOF = True
Dim lngMean As Long
Dim lngRAD78max As Long
Dim lngRAD78_1 As Long
Dim lngRAD78_2 As Long
Dim lngRAD78_3 As Long
Dim lngRAD7 As Long
Dim lngRAD8 As Long
lngRAD78_1 = rst![RAD78_1]
lngRAD78_2 = rst![RAD78_2]
lngRAD78_3 = rst![RAD78_3]
lngRAD8b_c = rst![RAD8b_c]
lngMean = (lngRAD78_1 + lngRAD78_2 + lngRAD78_3) / 3
lngRAD78max = Maximum(Abs(lngRAD78_1), Abs(lngRAD78_2), Abs(lngRAD78_3))
lngRAD7 = ((lngRAD78max - lngMean) / lngMean) * 100
lngRAD8 = ((lngMean - lngRAD8b_c) / lngRAD8b_c) * 100
txtRAD8.Value = lngRAD8
rst.MoveNext
Loop
rst.Close
dbs.Close
End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Calc
End Sub
Here's a second approach to this. Rather than using a function in the code, take the calculations from your Calc() routine and put them in another query.
SELECT idrRAD78,
(RAD78_1 + RAD78_2 + RAD78_3) AS Mean,
(IIf(Abs(RAD78_1) > Abs(RAD78_2),
IIf(Abs(RAD78_1) > Abs(RAD78_3), RAD78_1, RAD78_3),
IIf(Abs(RAD78_2) > Abs(RAD78_3), RAD78_2, RAD78_3))) AS RAD78Max,
(((RAD78max - Mean) / Mean) * 100) AS RAD7,
(((Mean - RAD8b_c) / RAD8b_c) * 100) AS RAD8
FROM qryrRAD78
This will give you a query that performs the same calculations as your existing function. Then just edit the report query to join to this new query (just like joining a table) using something like:
FROM ReportQuery INNER JOIN NewQuery ON ReportQuery.idrRAD78 = NewQuery.idrRAD78
Change the query names to match the real names. Add the fields from the new query in the SELECT part of your report query:
SELECT <existing field list>, RAD7, RAD8
Then set txtRAD8 to the RAD8 field.
I'm just doing this from memory as I'm not in front of my own computer, but hopefully that makes sense and is close enough to the correct code.
The problem with this function is that every row on the report is going to have a textbox called txtRAD8. So what you are really doing is updating every textbox on the report with the same value (once for every loop through the recordset). You are not actually setting the value for each individual row.
What you need to do is make the value of the textbox = Calc(RowID). Then your query uses the passed-in parameter to get the value for that one record instead of looping through the whole recordset, and updates just that one row on the report.
So your Sub becomes a Function, and returns the calculated value.
The data I have can be simplified to this:
http://i.imgur.com/mn5GgrQ.png
In this example, I would like to delete the data associated with track 2, since it has only 3 frames associated with it. All data with more than 3 associated frames can stay.
The frame number does not always start from 1, as I've tried to demonstrate. The track number will always be the same number consecutively for as many frames as are tracked. I was thinking of using a function to append 1 to a variable for every consecutive value in column A, then performing a test to see if this value is equal >= 3. If so, then go onto the next integer in A, if no, then delete all rows marked with that integer (2, in this case).
Is this possible with Visual Basic in an Excel Macro, and can anyone give me some starting tips on what functions I might be able to use? Complete novice here. I haven't found anything similar for VBA, only for R.
I assume you understand the code by reading it.
Option Explicit
Public Function GetCountOfRowsForEachTrack(ByVal sourceColumn As Range) As _
Scripting.Dictionary
Dim cell As Range
Dim trackValue As String
Dim groupedData As Scripting.Dictionary
Set groupedData = New Scripting.Dictionary
For Each cell In sourceColumn
trackValue = cell.Value
If groupedData.Exists(trackValue) Then
groupedData(trackValue) = cell.Address(False, False) + "," + groupedData(trackValue)
Else
groupedData(trackValue) = cell.Address(False, False)
End If
Next
Set GetCountOfRowsForEachTrack = groupedData
End Function
Public Sub DeleteRowsWhereTrackLTE3()
Dim groupedData As Scripting.Dictionary
Set groupedData = GetCountOfRowsForEachTrack(Range("A2:A15"))
Dim cellsToBeDeleted As String
Dim item
For Each item In groupedData.Items
If UBound(Split(item, ",")) <= 2 Then
cellsToBeDeleted = item + IIf(cellsToBeDeleted <> "", "," + cellsToBeDeleted, "")
End If
Next
Range(cellsToBeDeleted).EntireRow.Delete
End Sub
GetCountOfRowsForEachTrack is a function returning a dictionary (which stores track number as key, cell address associated with that track as string)
DeleteRowsWhereTrackLTE3 is the procedure which uses GetCountOfRowsForEachTrack to get the aggregated info of Track numbers and cells associated with it. This method loops through the dictionary and checks if the number of cells associated with track is <=2 (because splitting the string returns an array which starts from 0). It builds a string of address of such cells and deletes it all at once towards the end.
Note:
Add the following code in a bas module (or a specific sheet where
you have the data).
Add reference to "Microsoft Scripting.Runtime" library. Inside VBA, click on "Tools" -> "References" menu. Tick the "Microsoft Scripting.Runtime" and click on OK.
I have used A2:A15 as an example. Please modify it as per your cell range.
The assumption is that you don't have thousands of cells to be deleted, in which case the method could fail.
Make a call to DeleteRowsWhereTrackLTE3 to remove such rows.
I recently got into Excel macro development after a long time of not having the need to.
I have one column with two-hundred rows where each row has a value. I wrote a loop to iterate to each row value, read the current value and then write the value back minus the last character.
Here is some actual (and pseudo) code of what I wrote.
Dim theRow as Long
Dim totRow as Long
Dim fooStr as String
theRow = 2 'we begin on the second row of the colummn
totRow = 201 'there are 200 values
For theRow = 2 to totRow
fooStr = WorkSheets(DestSheet).Cells(theRow,"A").Formula 'read the cell value
fooStr = Left(fooStr,Len(fooStr)-1 'subtract the last character from the value
Cells(theRow,1).Value = fooStr 'write the value back
Next theRow
After I did some reading I learned that it is best practice to read and write values using a Range. Is it possible to rewrite what I am doing using a Range so it willl go faster.
Here is what I came up with so far.
Range("A2:A201").Value = Len(Range.Left("A2:A201").Value)-1
However, this doesn't work.
Any clues on how to do this if this is indeed possible?
Thanks for any tips.
If you want maximum performance (you don't need it for 200 rows, but...) you have to minimize the number of reads and writes (mostly writes) to ranges. That means reading the whole range into an array, manipulating the array, then writing it back to the range. That's one read and one write compared to 200 in a loop. Here's an example.
Sub RemoveLastChar()
Dim vaValues As Variant
Dim i As Long
vaValues = Sheet1.Range("A2").Resize(200).Value
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
vaValues(i, 1) = Left$(vaValues(i, 1), Len(vaValues(i, 1)) - 1)
Next i
Sheet1.Range("A2").Resize(UBound(vaValues, 1), UBound(vaValues, 2)).Value = vaValues
End Sub
You could do something like
Sub StringTrim()
Dim xCell as Range
Range("A1:A201").Select
For Each xCell in Selection
xCell.Value = Left(xCell.Value, Len(xCell.Value) - 1)
Next
End Sub
I don't know what kind of speed improvements you are seeking, but that would also do the job.
You might know this already but putting Application.ScreenUpdating = False at the top of your code can speed it up significantly (unless you like to watch everything flash by as the script works). You should reset the value to True at the end of your code.
i have a MS access database with a table such as the one below and i am trying to figure out the sql needed to determine the total number of times the date changes across all the fields for each defectID record.
also, note that each day i add a field to the table, so if this can be made dynamic that would be best.
when there are no dates i would like the result to display 0 (zero)
thanks all
you definitely have a normalization issue here.
you should consider moving the date to another table - maybe similar to the following:
Retest Estimate
-----------------
defect_id
estimate_date
ready_date
You are treating a database like a spread sheet. It would be better to set up a table on these lines:
DefectID
TestDate
Est_ReadyForRetest
This means that you are adding records each day, rather than fields. It will also make queries easier.
I agree with the suggestion that the data ought to be normalized, but then you have a different problem for answering the question, one that I'm not sure how you'd do it in SQL (since it is based on the order of the records). That is, you'd have to walk a recordset to do it. I guess a correlated subquery could do the trick, but it would have to based on something that can be ordered.
My SQL skills are not fabulous, so in the abstract I won't suggest a SQL solution, but maybe somebody else will.
Instead, I'll suggest a function that could return the answer in the original unnormalized data structure. I base this on my existing iMax() function, which goes like this:
Public Function iMax(ParamArray p()) As Variant
' Idea from Trevor Best in Usenet MessageID
' rib5dv45ko62adf2v0d1cot4kiu5t8mbdp#4ax.com
Dim i As Long
Dim lngUBound As Long
Dim v As Variant
v = p(LBound(p))
lngUBound = UBound(p)
For i = LBound(p) + 1 To lngUBound
If v < p(i) Then
v = p(i)
End If
Next
iMax = v
End Function
The idea is using a parameter array to pass the values to the function, and then walking the array to get the information you need. In this case, you'd want to walk the array and count the number of times it changes, something like this:
Public Function CountChange(ParamArray varInput()) As Long
Dim varValue As Variant
Dim varPrevious As Variant
Dim lngCount As Long
varPrevious = varInput(0)
For Each varValue In varInput()
If varValue <> varPrevious Then
lngCount = lngCount + 1
End If
varPrevious = varValue
Next varValue
CountChange = lngCount
End Function
I haven't tested that very thoroughly, and it doesn't deal with Nulls at all, but that's the idea -- it's very useful concept for comparing data from fields within a single row.