my code is running very slow, is it the 2 For loops causing it?
Thanks
For x = LBound(dataArray) To UBound(dataArray) 'define start and end of array, lower bound to upper bound
For Each rngcell In Range("A:B") 'lookup each cell in row 1
If dataArray(x) = rngcell.Value Then ' if cells in header row match with values in array
rngcell.EntireColumn.Copy ' then copy whole column of data for that parameter
Sheets(3).Select ' select sheet to paste data
Range("A:B").End(xlUp).Offset(rowOffset:=0, columnOffset:=x).Select 'select area to paste, paste in next column - no. x
Selection.PasteSpecial xlPasteValues ' paste
End If
Next rngcell ' next header row cell
Next x
End Sub
Just a few suggestions:
Doing .Select causes Excel to update the UI, which is expensive. Try to calculate the target cell/range ONCE and use that to call PasteSpecial and not Selection.
Selecting the Sheet(3) could be done before the loop, as it doesnt change.
IF (!) max. ONE dataArray Element matches ONE rngcell.Value, you could abort the rest of the inner loop by using Exit For before the End If, saving the useless rest of the loop.
You're using Range(A:B) which is definitely slowing your code down.
Excel will basically read every cell in that range according to your code.
That's 2 million cells.
Try to limit the range on the B by using something like Replace(Range("B").End(Xldown).Address,"$B$","").
Related
I have the following block of code that iterates through the fields of each table and adds the fields of the current table respectively in order to create a number of tableboxes.
'iterate through every table
For i=1 To arrTCount
'the arrFF array holds the names of the fields of each table
arrFF = Split(arrFields(i), ", ")
arrFFCount = UBound(arrFF)
'create a tablebox
Set TB = ActiveDocument.Sheets("Main").CreateTableBox
'iterate through the fields of the array
For j=0 to (arrFFCount - 1)
'add the field to the tablebox
TB.AddField arrFF(j)
'Msgbox(arrFF(j))
Next
Set tboxprop = TB.GetProperties
tboxprop.Layout.Frame.ObjectId = "TB" + CStr(i)
TB.SetProperties tboxprop
Next
The above code creates the tableboxes, but with one field less every time (the last one is missing). If I change the For loop from For j=0 To (arrFFCount - 1) to For j=0 To (arrFFCount) it creates empty tableboxes and seems to execute forever. Regarding this change, I tested the field names with the Msgbox(arrFF(j)) command and it shows me the correct field names as I want them to be in the tableboxes in the UI of QlikView.
Does anybody have an idea of what seems to be the problem here? Can I do this in a different way?
To clarify the situation here and what I have tested so far, I have 11 tables to make tableboxes of and I have tried with just one of them or some of them. The result I am seeing with the code is on the left and what I am expecting to see is on the right of the following image. Please note that the number of fields vary for each table and the image has just one of them as an example.
Ive been trying to write Access VBA code to automate the addition of replicates for germination tests.
Basically I have a form where I enter the total number of Reps (NoofReps) and the number of seeds per rep (RepSize) (e.g. 50 seeds). For each record added I want it to automatically add a record for each rep and automatically calc the Rep Number (i.e if i have 4 reps then it should add 4 records, numbered 1-4 reps) as well as the RepSize (e.g 50).
I have been trying out various loops based on information from this forum and other but am still getting errors with the number of records that it generates. I have tried both the "Do while" and "Do Until" but get the same result below either way.
Could someone please let me know where I am going wrong?...If i want 2 reps then it adds 2, If i want 3 then its 246, and if i want 4 it adds >30,000!!!
For the purposes of trying to fix the code I have started to type the number of reps manually into the code in the iNoofReps so that I know the error is in the code and not from the form.
Private Sub CmdAddReps3_Click()
Dim iRepNo As Integer ' stores the current value in the series
'Open the table
Set db = CurrentDb()
Set rstGReps = db.OpenRecordset("tblGReplicates")
' Initialise the variables
iRepNo = 1
iNoofReps = 3 'iNoofReps = Me.txtNoofReps
' Add the records using a loop
rstGReps.movefirst
Do 'Until rstGReps("RepNo") = (iNoofReps + 1) ' always want to include at least 1 repNo
rstGReps.AddNew
rstGReps("GTestID") = Me.GTestID
rstGReps("RepNo") = iRepNo
rstGReps("NoofSeed") = Me.txtNoOfSeeds
' Calculate the next RepNo value in the loop
iRepNo = iRepNo + 1
rstGReps.Update
rstGReps.moveNext
Loop Until rstGReps("RepNo") = (iNoofReps) + 1 ' so that the loop includes the final repNo.
MsgBox "Finished Looping"
rstGReps.Close
Set rstGReps = Nothing
Set db = Nothing
End Sub
Any help would be appreciated!!!
Well, you're moving next here: rstGReps.moveNext, and then you're comparing rstGReps("RepNo") = (iNoofReps) + 1 after moving next, thus being on an empty record, thus always equating to false.
Loop Until iRepNo = (iNoofReps) + 1 should fix it, then you're no longer referring to the recordset, which has already been set to the next record by the time you're referring to it.
You could also fix it by just eliminating this line:
rstGReps.moveNext
Since rstGReps.AddNew already moves the recordset to a new blank record, moving it forward after adding the record doesn't make much sense. If you remove it, you might want to remove the + 1 in Loop Until rstGReps("RepNo") = (iNoofReps) + 1
I am using msflexgrid in VB6. How can I remove or resolve the following error:
Subscript out of range.
With flxData(0)
For i = 1 To .Rows - 1
Do While cboselect <> .TextMatrix(i, 1)
.RemoveItem (i)
Loop
Next i
End with
Just realized that the Do While loop inside of the For loop will cause the error to display - once a row doesn't have the desired cboselect value, it's going to call RemoveItem for that and all the remaining rows, until it's deleted all of them, then it'll display the message when it tries to delete a (now) non-existent row.
I'm guessing that you want to be removing just the rows that don't match the cboselect value, so that would call for an If statement. You also do need to run the For loop backwards. Try this:
With flxData(0)
For i = .Rows - 1 to 1 Step -1
If cboselect <> .TextMatrix(i, 1) Then
.RemoveItem (i)
End If
Next i
End With
I'm currently coding in ASP for the first time, and have arrived at ADO. Let's say I have a query that is as follows:
SQL = "SELECT President FROM Testing"
And the table is as follows:
President
------------------
George Washington
John Adams
Thomas Jefferson
James Madison
James Monroe
The code I originally got from W3 is as follows:
For Each x In recordset.fields
Response.Write(x.name)
Response.Write(" = ")
Response.Write(x.value & "<br>")
Next
But then it only returns:
President = George Washington
when I expected the whole table. It wasn't until I changed it to this from W3:
Do Until Recordset.EOF
For Each x In recordset.fields
Response.Write(x.name)
Response.Write(" = ")
Response.Write(x.value & "<br>")
Next
Response.Write("<br>")
Recordset.MoveNext
Loop
That I get all of the names. Can someone help me visualize what's happening? I figured in the first piece of code, it would loop through the table until it gave me all of the names, but that wasn't the case. Pretty much, "For each recordset field, write the column name + equal sign + the value of the current row, then move on to the next row."
Or is it because I'm not understanding recordset properly?
Your For Each loop enumerates the fields of the current record (vulgo "row") of your recordset. You need another loop to move the "current record" indicator through the recordset to iterate over all records/rows. That's what
Do Until recordset.EOF 'stop after the last record
... 'do stuff
recordset.MoveNext 'move to the next record
Loop
does.
As both myself and #sean-lange have already pointed out in the comments above.
The Fields collection contains the columns for the current record only.
So we have the Columns what about the Rows?
The ADODB.Recordset object contains both column and row data how do we get to the rows? Recordsets behave differently dependant on the cursor used but for this let's assume that we can move back and forth.
#sean-langes analogy is best, think of the ADODB.Recordset as an Excel Spreadsheet and the Fields collection is the columns across the top. If we tab from left to right across a row we only see data for that current row, to get the next row we have to move down the spreadsheet. The same is true for an ADODB.Recordset which is provided by the MoveNext() method. This tells the cursor to move to the next record and repopulate the Fields collection with the row values.
The second example you posted is a common technique used to iterate through the records in a ADODB.Recordset. Let's break -down what that code is doing;
This begins the loop and tell's Classic ASP to continue looping the contained code until the cursor has reached the .EOF (End of File) equal to True. This signals the cursor has past the final record and there is no more records to process by calling MoveNext().
Do While Not recordset.EOF
During the loop we have a current record so while this is the case we can access the Fields collection and enumerate the data.
For Each x In recordset.fields
The key is MoveNext which moves the cursor to the next record and repopulates the collections such as Fields associated to the current record.
recordset.MoveNext
Note: I have little experience with VB. The reason the first piece of code only returns George Washington is because the pointer is not advanced in the recordset. The pointer is fixed on record 0 (working in arrays) and therefore, I believe, returning George Washington 5 times. In the second example, the pointer is moved after every iteration (Recordset.MoveNext) and therefore will print all the names.
The first code is doing: Response.Write(x[0]) 5 times.
The second code is doing: Response.Write(x[0]) move pointer Response.Write(x[1]]), etc
SQL = "SELECT President FROM Testing"
Set objRs = objConnection.Execute(SQL)
Do While Not objRs .EOF
Response.Write objRs("President") & "<br>"
objRs.MoveNext
Loop
I am working with a fairly small worksheet that has been developed by someone else. In this worksheet I have approx. 500 rows and some 100 columns (these values change dynamically).
The document adds validation lists to some cells based on a named range in another worksheet in the same workbook. This currently works, but very slowly.
The cells I would like to target are cells that on the same row, in column A, have a certain value. The cells should also have a specific name in its "header".
Currently, I am using a find statement to find all correct columns, and then for each of those columns I check the value in column A for the correct one, and if it is, I add the range.
Now to the question; How can I speed this up? When the sheet is at its largest it takes over a minute to complete the code, and since that happens when you open the sheet, people using the sheet are complaining. :)
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets(A).Activate
Sheets(A).Unprotect Password:=Str_SheetPassword
'Get each data ranges
Set Rg_TitleRange = ...
Set Rg_dataRange = ...
'Loop on each column that contains the keyword name
Set Rg_ActionFound = Rg_TitleRange.Find(Str_ColName, LookIn:=xlFormulas, _
lookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True)
If Not Rg_ActionFound Is Nothing Then
'Loop on each action column
Do
'For each data row, update the cells with validation list
For Int_RowIndex = 0 To Rg_dataRange.Rows.Count - 1
'Change cells wich are at the intersection of test definition row and action name column.
If Rg_dataRange(Int_RowIndex, 1) = Str_RowName Then
Set Val_ActionValidationList = Rg_dataRange(Int_RowIndex, Rg_ActionFound.Column).Validation
Val_ActionValidationList.Delete
Rg_dataRange(Int_RowIndex, Rg_ActionFound.Column).Validation.Add _
Type:=xlValidateList, Formula1:=("=" + Str_ValidationList)
End If
Next
'Loop end actions
Int_PreviousActionFoundColumn = Rg_ActionFound.Column
Set Rg_ActionFound = Rg_TitleRange.Find(CommonDataAndFunctionMod.Str_ActionNameRowLabel, Rg_ActionFound, LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True)
Loop While Rg_ActionFound.Column > Int_PreviousActionFoundColumn
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
I have tested to just comment out the row where the validation is added, so I'm fairly sure that row is the time consumer (mostly). I would take any suggestions.
Thank you in advance!
After some tries I ended up redoing the code so that this routine is run on certain other events instead, hence removing the loading time on start up. The validations are updated only when needed now.
Thank you all for your suggestions!
As you used Loop inside a loop will always slows down the code. think of different algorithm try to use Exit Loop and Exit Do When to cut down the looping time.