After the 12th found match of the loop, I have a Run-time Error 9 on the rptVals array. Basically, the rptcount hits 247 - where rptRows has a count of 246. I have tried doubling and quadrupling the size of rptRows, and each time I pass the 12th match I get the error. I tried loading a different data set that has one more row of data than the first workbook, and I get the error there after the 13th match - again regardless of rptRows count size, but always matching report counts maximum count.
Any ideas why this is happening? Also, I'm a chemist, not a programmer, so sorry if this isn't the prettiest code or the most efficient or whatever. If it works, I'm happy. Also, I've been made aware of Dictionaries, but I have a better grasp on arrays and loops than I do dictionaries (which obviosly isn't saying much, but oh well).
Sub PrntFllEle()
With Workbooks("Full Element Analysis Current").Worksheets("All _
Samples")
rptRows = Range("H6:IS6").Columns.Count 'here is the start of the
'problem. rptRows = 246
'rptrng = rptRows * 2 I made this variable to double/quadruple the _
size of rptRows count
rptVals = .Range("H6:IS6" & rptRows).Value
End With
With Workbooks(FlNm).Worksheets("Report")
'rEleAn, seen below the range of data captured in a separate sub.
'This will also have an associated array ElAr from the other sub.
chkRows = rEleAn.Rows.Count
End With
For rptcount = LBound(rptVals) To UBound(rptVals)
For chkcount = LBound(ElAr) To UBound(ElAr)
If rptVals(1, rptcount) <> "" Then 'I had to include this as _
I have some blank cells _
in array and this was the _
quickest way to deal with it.
'This next line is where the run-time error occurs. rptVals = _
Subscript out of Range and rptcount = 247
'Note, the UBound(rptVals) is 6241.
If rptVals(1, rptcount) = Mid((ElAr(chkcount, 1)), 1, 2) Then
MsgBox rptVals(1, rptcount)
'MsgBox just a place holder for now.
End If
Else
Exit For
End If
Next
Next
End Sub
All variables are global, btw. I've check those values, and everything that could affect this is Long. All arrays are Variants as I have strings and numbers to deal with. Ranges are appropriately Dim As Range.
Your For ... Next construction is defaulting to the first rank of your array. You want the second rank.
For rptcount = LBound(rptVals, 2) To UBound(rptVals, 2)
For chkcount = LBound(ElAr, 1) To UBound(ElAr, 1)
Related
I've run into a strange problem:
I have two separate arrays with 3 attributes I'm trying to match to determine if all three attributes match, partial matches, or no matches.
I have a loop to loop through the values in the first array and a second nested loop within that loop to loop through the second array for each line of the first array.
Here's where it get's weird: I have three If-statement gates that check if the first attribute (amount) is equal in each of the arrays, then the second attribute (trace), and finally the last attribute (customer).
I have a line item in one array that matches on the amount (as it should), but then fails on the trace check (where it shouldn't).
I've used Debug.Print to see if the values are the same. They are. I checked that the format from the original data is the same (i.e. no spaces/hidden characters etc.). I made sure that when the array is populated from the cells, it uses the .Value method.
Even though I've checked all these, and the Debug.Print shows they are the same, it fails the check when comparing the two values.
Here's the code:
For RemMatchLoop = LBound(RemAmtMatchArray, 2) To UBound(RemAmtMatchArray, 2) Step 1
PerfectMatchFound = False
For MMMatchLoop = LBound(MMAmtMatchArray, 2) To UBound(MMAmtMatchArray, 2) Step 1
If MMAmtMatchArray(MMAmountCol, MMMatchLoop) = RemAmtMatchArray(RemAmountCol, RemMatchLoop) Then
Debug.Print "MM Trace: " & MMAmtMatchArray(MMTraceCol, MMMatchLoop)
Debug.Print "Rem Trace: " & RemAmtMatchArray(RemTraceCol, RemMatchLoop)
If MMAmtMatchArray(MMTraceCol, MMMatchLoop) = RemAmtMatchArray(RemTraceCol, RemMatchLoop) Then
If MMAmtMatchArray(MMCustomerCol, MMMatchLoop) = RemAmtMatchArray(RemCustomerCol, RemMatchLoop) Then
ReDim Preserve RemPerfectMatchArray(1 To RemLastCol, 1 To RemPerfectMatchCount) As Variant
For RemPerfectMatchColFill = 1 To RemInBalanceCol Step 1
RemPerfectMatchArray(RemPerfectMatchColFill, RemPerfectMatchCount) = RemAmtMatchArray(RemPerfectMatchColFill, RemMatchLoop)
If RemPerfectMatchColFill = RemAmountCol Then
Debug.Print "Perfect Match Amount: " & RemPerfectMatchArray(RemPerfectMatchColFill, RemPerfectMatchCount)
End If
Next RemPerfectMatchColFill
RemPerfectMatchCount = RemPerfectMatchCount + 1
PerfectMatchFound = True
End If
End If
End If
Next MMMatchLoop
Here's what the Debug.Print has spit out regarding the line item in question:
MM Trace: 1234
Rem Trace: 1234
So, both traces are the same, but when it passes the line:
If MMAmtMatchArray(MMTraceCol, MMMatchLoop) = RemAmtMatchArray(RemTraceCol, RemMatchLoop) Then
It detects them as not-equal.
UPDATE: One type is Double and the other is String. Not sure why, because the data the array resulting in a String value pulls from is not Text format and is a number.
Additionally, when the data is populated into the array, it uses the .Value method, as seen below:
For RemAmtMatchColFill = 1 To RemLastCol Step 1
RemAmtMatchArray(RemAmtMatchColFill, RemAmtMatchCount) = RemWS.Cells(RemAmtMatchLoop, RemAmtMatchColFill).Value
Next RemAmtMatchColFill
Not sure why then it's detecting a string...
Any help would be appreciated, as I'm completely baffled.
RESOLUTION
After using Typename() suggested in the comments to identify what types are being compared, it was determined that the Variant array was converting Currency data types in both source data into Double type in one array and String type in another. While it's strange that it's doing this, by using CStr() to convert both values to strings while comparing fixed the issue.
Thanks!
Joe
I have a macro that inserts a VLOOKUP into a column. The macro has to take a number stored as text and convert it to a number, before looking up that number in another sheet.
The macro always produces the same results, such as reaching row 43 before starting to produce erroneous results however when using F8 to step through the code, these incorrect results are not produced.
The erroneous results are that the value placed into col 13 is not equal to the number stored as text. Mostly it seems as though values from rows above and below, sometimes 2 rows below are being inserted to col 13. Almost seems to me as if 2 different threads are running at 2 different speeds or something?
If anyone could have a look at the loop causing the errors I would be grateful, thanks.
For counter = 2 To NumRowsList
checker = CInt(Sheets("Sheet2").Cells(counter, 3)
Sheets("Sheet2").Cells(counter, 13).Value = checker
'Call WaitFor(0.5)
If checker < 4000 Then
Sheets("Sheet2").Cells(counter, 14) = "=VLOOKUP(M" & counter & ",Sheet4!E2:F126,2,FALSE)"
Else
Sheets("Sheet2").Cells(counter, 14) = "=VLOOKUP(M" & counter & ",Sheet5!B2:C200,2,FALSE)"
End If
Next counter
I have tried a few similar variations of this code, such as using the value stored in col 13 directly rather than using the cell reference in the VLOOKUP, always producing the same results.
I even used the waitfor function to try and create a delay hoping it may synchronise the operations, but it did not help and using a delay of more than 0.5 would cause the run time of the macro to be too big.
UPDATE:
I did not find a perfect solution, only a long hand work around. I simply combined the Vlookups onto a single sheet, and converted the numbers stored as text to numbers outside of the vba routine. This took the error away from the number calculation (just col C * 1), and then the vlookups were looking up the correct values. Thank you for the help, regardless.
you can avoid looping, checker and all those If-Then-Else, like follows
edited to account for VlookUp range depending on VlookUp value
With Worksheets("Sheet2")
.Range("N2", .Cells(NumRowsList, 14)).FormulaR1C1 = "=VLOOKUP(Value(RC3),IF(Value(RC3)<4000,Sheet4!R2C5:R126C6,Sheet4!R2C2:R200C3),2,FALSE)"
End With
The following works for me with my test data, but you'll need to see if it works for you... (also are you turning off calculation or events? I don't know if this might have an issue?)
I find it preferable to set a reference to the sheet you want to use rather than access it directly, and this may help?
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim VLURange As String, checker As Long
For counter = 2 To 200 ' NumRowsList
checker = CLng(ws.Cells(counter, 3).Value)
ws.Cells(counter, 13) = checker
VLURange = IIf(checker < 4000, "Sheet4!E2:F126", "Sheet5!B2:C200")
ws.Cells(counter, 14) = "=VLOOKUP(M" & counter & ", " & VLURange & ", 2, FALSE)"
Next counter
I'm attempting to use a Scripting Dictionary in a way as to be able to find and ultimately highlight same values or groups of same values where there are inconsistencies (ie blanks or different values in between the two same values or groups of same values). Normally these same values will repeat, but what I'm trying to catch is when they do not repeat together (See example image below taken from my previous post).
Some context that will hopefully help this make a little more sense:
This is a follow-up of sorts to one of my previous questions here. I have a conditional formatting formula:
=NOT(AND(IFERROR(COUNTIF(OFFSET(A1,0,0,-COUNTIF($A$1:$A1,A2)),A2),0)=IFERROR(COUNTIF($A$1:$A1,A2),0),IFERROR(COUNTIF(OFFSET(A3,0,0,COUNTIF($A3:$A$5422,A2)),A2),0)=IFERROR(COUNTIF($A3:$A$5422,A2),0),A2<>""))
Which works perfectly. However, in my tinkering after receiving this formula as the answer to that previous question I realized that using conditional formatting of any sort for the amount of data I typically deal with (15000+ rows with 140 consistent columns) is an extremely slow endeavor, both when applying the formula and when filtering/adjusting afterwards. I've also tried applying this formula via the "helper column" route, but to no surprise, that is just as slow.
So, where I'm at now:
Essentially, I'm trying to translate that formula into a piece of code that does the same thing, but more efficiently, so that's where I starting thinking to use a Scripting Dictionary as a way to speed up my code execution time. I have the steps outlined, so I know what I need to do. However, I feel as though I am executing it wrong, which is why I'm here to ask for assistance. The following is my attempt at using a Scripting Dictionary to accomplish highlighting inconsistencies in Column A (my target column) along with the steps I figured out that I need to do to accomplish the task:
'dump column A into Array
'(Using Scripting.Dictionary) While cycling through check if duplicate
'IF duplicate check to make sure there is the same value either/or/both in the contiguous slot before/after the one being checked
'If not, then save this value (so we can go back and highlight all instances of this value at the end)
'Cycle through all trouble values and highlight all of their instances.
Sub NewandImprovedXIDCheck()
Dim d As Long, str As String, columnA As Variant
Dim dXIDs As Object
Application.ScreenUpdating = False
Set dXIDs = CreateObject("Scripting.Dictionary")
dXIDs.comparemode = vbTextCompare
With ActiveSheet
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
'.Value2 is faster than using .Value
columnA = .Columns(1).Value2
For d = LBound(columnA, 1) To UBound(columnA, 1)
str = columnA(d, 1)
If dXIDs.exists(str) Then
'the key exists in the dictionary
'Check if beside its like counterparts
If Not UBound(columnA, 1) Then
If (str <> columnA(d - 1, 1) And str <> columnA(d + 1, 1)) Or str <> columnA(d - 1, 1) Or str <> columnA(d + 1, 1) Then
'append the current row
dXIDs.Item(str) = dXIDs.Item(str) & Chr(44) & "A" & d
End If
End If
Else
'the key does not exist in the dictionary; store the current row
dXIDs.Add Key:=str, Item:="A" & d
End If
Next d
'reuse a variant var to provide row highlighting
Erase columnA
For Each columnA In dXIDs.keys
'if there is more than a single cell address, highlight all
If CBool(InStr(1, dXIDs.Item(columnA), Chr(44))) Then _
.Range(dXIDs.Item(columnA)).Interior.Color = vbRed
Next columnA
End With
End With
End With
dXIDs.RemoveAll: Set dXIDs = Nothing
Application.ScreenUpdating = True
End Sub
I feel like my logic is going wrong somewhere in my code execution, but can't seem to pinpoint where or how to correct it. Any help would be greatly appreciated. If you can provide any sort of code snippet that would also be a great help.
Here's one approach:
Sub HiliteIfGaps()
Dim rng As Range, arr, r As Long, dict As Object, v
Dim num As Long, num2 As Long
Set dict = CreateObject("scripting.dictionary")
With ActiveSheet
Set rng = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp))
End With
arr = rng.Value
For r = 1 To UBound(arr, 1)
v = arr(r, 1)
If Len(v) > 0 Then
If Not dict.exists(v) Then
num = Application.CountIf(rng, v) 'how many in total?
'all where expected?
num2 = Application.CountIf(rng.Cells(r).Resize(num, 1), v)
dict.Add v, (num2 < num)
End If
If dict(v) Then rng.Cells(r).Interior.Color = vbRed
Else
'highlight blanks
rng.Cells(r).Interior.Color = vbRed
End If
Next r
End Sub
EDIT: every time a new value is found (i.e. not already in the dictionary) then take a count of how many of those values in total there are in the range being checked. If all of those values are contiguous then they should all be found in the range rng.Cells(r).Resize(num, 1): if we find fewer than expected (num2<num) then that means the values are not contiguous so we insert True into the dictionary entry for that value, and start highlighting that value in the column.
#Tim Williams's approach did the job perfectly! I only made one slight alteration (to suit my needs). I changed
.Cells(.Rows.Count, 1).End(xlUp) to .Range("A" & .UsedRange.Rows.count)
Just because there are instances where the bottom-most row(s) might have missing values (be blank) and in this instance I feel safe enough using the .UsedRange reference because this snippet of code is one of the very first ones ran in my overall macro, so it (.UsedRange) is more likely to be accurate. I also added a Boolean operator (xidError, set to False) to be changed to True whenever we have to highlight. After I'm done looping through the Array I check xidError and if True I prompt the user to fix the error, then end the entire macro since there's no use in continuing until this particular error is corrected.
If xidError Then
'Prompt User to fix xid problem
MsgBox ("XID Error. Please fix/remove problematic XIDs and rerun macro.")
'Stop the macro because we can't continue until the xid problem has been sorted out
End
End If
Again, much thanks to Tim for his very efficient approach!
I am trying to compare two columns of cells in vba using the match function. I am comparing the second column against values in the first and copying and pasting the values that aren't found to another column. I am doing the same with the second against the first as well. For some reason when I try to run this it says that it cannot get the match property of the worksheet function class and I am really confused as to why I am receiving this error. I have pasted the code below. Any help with this issue would be greatly appreciated.
Set PrevMonth = Sheet13.Range(Range("A2"), Range("A2").End(xlDown))
Set currMonth = Sheet13.Range(Range("B2"), Range("B2").End(xlDown))
Count = 2
For i = 2 To PrevMonth.Rows.Count
match = Application.WorksheetFunction.match(Cells(i, 1), currMonth, 0)
If WorksheetFunction.IsNA(match) = True Then
Sheet13.Cells(i, 1).Cut
Sheet13.Cells(Count, 3).Paste
Count = Count + 1
End If
Next i
For i = 2 To currMonth.Rows.Count
match = WorksheetFunction.match(Cells(i, 1), PrevMonth, 0)
If WorksheetFunction.IsNA(match) = True Then
Sheet13.Cells(i, 1).Cut
Sheet13.Cells(Count, 4).Paste
Count = Count + 1
End If
Next i
Can you try using
Application.Match(Cells(i, 1), currMonth, 0)
I know this should have been a comment...but I'm unable to comment as I'm below 50 Rep...
In my experience the "cannot get 'X' property of the worksheet function class" error is indicative that a poor argument has been passed to the worksheet function itself. In your case the arguments are: Cells(i, 1), currMonth. This likely means one of those ranges are inaccessible. If I had to guess, you want to be passing sheet13.cells(i,1). I'd recommend a 'with sheet13' statement for this whole segment of code. WorksheetFunction.Match in particular will throw that error if a match can't be found (VB doesn't work with the #N/A return value). Using a WorksheetFunction.CountIf > 0 can ensure there is a viable match within the range.
Also, Range("A2").End(xlDown) will result in the last cell of the column if there is no data after A2. This is generally unfavorable behavior.
I have a loop wherein I take the mean of several columns of numbers with the same number of rows each.
The point of the loop is to capture these means in a new vector.
So for each loop I need to indicate "all rows". In matlab this would be easy, just use ":" But I can't figure out what the analogy is in VB. Please help! Thanks.
(Please advise me as to what I put in the code below where I have ALLROWS).
My attempt so far:
For i = 1 To CA
mrCA11(i) = Application.WorksheetFunction.Average(revCA11(**ALLROWS**,i))
Next i
In matlab this would be:
For i = 1:CA
mrCA11(i) = mean(revCA11(:,i));
Next i
EDIT: I've also tried this trick to no avail:
For j = 1 To CA
For i = 1 To s11
temp11(i) = revCA11(i, j)
Next i
mrCA11(j) = Application.WorksheetFunction.Average(temp11)
Next j
I get the error message: "Unable to get the Average property of the Worksheet Function class"
As everybody (Tim and shahkalpesh at least) pointed out, we need to understand what is revCall or more specifically, we need to understand how you want to give them ALL ROWS in argument.
Finding the last row (or column or cell)
A common Excel issue is to find the last used row / column / cell.
This will give you the end of your vector.
Excel give you several methods to deal with this:
xlTypeLastCell
Last cell used in the entire sheet (regardless if it's used in column A or not)
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
End(xlUp)
Last cell used (including blanks in-between) in Column A is as simple as this:
lastRow = Range("A" & Rows.Count).End(xlUp).Row
End(xlToLeft)
Last cell used (including blanks in-between) in Row 1 is as simple as this:
lastRow = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Row
UsedRange
Last cell used in the WorkSheet (according to Excel interpretation):
Set rangeLastCell = ActiveSheet.UsedRange
Using an array as argument
The methods above told you how to find the last row (if this is what you need). You can then easily create your vector and use it in your procedure revCA11.
You can either give an array as argument as Tim pointed out in his answer with this kind of statement:
myArray = ActiveSheet.Range("A1", Cells(lastRow, lastColumn).Value
Or you can use the integer (or long) to build your vector inside your procedure as simple as declaring a range:
Range("A1:A" & lastRow)
You might clarify exactly how revCA11 is declared/created, but maybe something along these lines might work for you:
Sub Tester()
Dim arr, x
arr = ActiveSheet.Range("A1:D5").Value '2-D array
'average each column
Debug.Print "Columns:"
For x = 1 To UBound(arr, 2)
Debug.Print x, Application.Average(Application.Index(arr, 0, x))
Next x
'average each row
Debug.Print "Rows:"
For x = 1 To UBound(arr, 1)
Debug.Print x, Application.Average(Application.Index(arr, x, 0))
Next x
End Sub