vba - Macro producing incorrect results when run, but when stepping into results are correct - vba

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

Related

Excel VBA Nested For Loop Returns Run Time Error 9

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)

Comparing two lists in excel and extracting values missing from 2nd list - cannot be duplicated (also over two sheets)

Im working on a project report for work and I'm trying to find a way to compare two lists of project codes i.e "123456" and see whether the 2nd list is missing any new values that would've been entered into the first list. The lists are thousands of records long and so far people have been doing it manually (it hurts me knowing this) so I'm trying to make it automatic.
What I have tried is using an Array with a Index(Match(CountIF))) formula but I just cant seem to get it working.
My problem is that when I get the array to fill with what i want I then can't get it to not duplicate values (I need it to check the masterlist so it doesnt output something more than once into the output list).
I've also tried to give it a go with other formulas - but the lists can be thousands of records long so I cant do a cell for cell match as the list would be huge (that or my excel knowledge isnt good enough to know the easy solution).
Any help would be hugely appreciated.
Array might not be the best solution
I've checked quite a few other solutions but they don't quite deal with my issue and I don't have the skill to adapt them.
Here is one approach using VBA and arrays which is quicker than doing via the sheet. It checks each item in H to see it is present in J (and not the other way round). I assume that's what you want.
Sub x()
Dim v1, v2, v3(), i As Long, j As Long
v1 = Range("H2", Range("H" & Rows.Count).End(xlUp)).Value
v2 = Range("J2", Range("J" & Rows.Count).End(xlUp)).Value
ReDim v3(1 To UBound(v1, 1))
For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i
Range("K2").Resize(j) = Application.Transpose(v3)
End Sub
Using an input box
Sub x()
Dim v1, v2, v3(), i As Long, j As Long
v1 = Application.InputBox("First list", Type:=8)
v2 = Application.InputBox("Second list", Type:=8)
ReDim v3(1 To UBound(v1, 1))
For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i
Range("K2").Resize(j) = Application.Transpose(v3)
End Sub
A formula solution.
Note that I turned the first two ranges into Tables and changed the names. The formula is using structured references. This enables the formula to auto update if you add rows in the future.
=IFERROR(INDEX(ProjList1[#Data],AGGREGATE(15,6,1/ISNA(MATCH(ProjList1[#Data],ProjList2[#Data],0))*ROW(ProjList1[#Data]),ROWS($1:1))-ROW(ProjList1[#Headers])),"")
How does it work? Briefly:
MATCH generates an array of #NA! errors or a number.
ISNA turns that into an array of TRUE/FALSE where TRUE indicates an entry in table 1 that is NOT in table 2
Multiplying that array by the array of project list rows returns an array of error message vs row number
AGGREGATE small function ignores the error returns to give an ascending list of row numbers
INDEX then returns the appropriate entry from Table 1
ROW(ProjList1[#Headers]) is a correction so that the table may be located anyplace on the worksheet, and still return the correct row.
Not sure if you're trying to set this up so it will autoupdate in future, but as a stopgap:
Countif column next to list 1 that checks whether they appear in list 2...
... Feeding into a pivot that only shows those where the countif value is 0, in the "row" field to remove duplication?

VBA Word table with unknown number of fused rows/columns

I'm currently trying to work with complex tables in Microsoft Word. My problem is, those tables have fused cells and rows, and I'm not sure of how many rows or columns i'll have.
Here is a (stupid) example how the kind of tables i'll have
I get my table thanks to a bookmark, and then proceed to stock the table in a Dim for easier access
Sub SetTable()
Dim tb as Table
Selection.GoTo What:=wdGoToBookmark, Name:="MyTable"
Selection.MoveDown
Set tb = Selection.Tables(1)
End Sub
Now, I'd use that table to write in several tables of a database.
Let's say, I have a table "Destinations", a table "Ways" and a table "Time"
I'm kinda blocked there.
With fused rows and columns, i cannot access a whole column or row. But as i don't know how many rows and columns i have (i could have, for example, 5 different ways for "Destination 1", or several distances in "Way 1")
I am a little lost on how i should try to work.
Cell(x,y).Row doesn't work because several rows are fused, and it is the same with Column, so we get errors extremely easily
I was thinking of putting tables in cells that might get an unknown number of rows/columns, a bit like this
The Problem with this method is that the person that'll write in the document won't be me. Meaning, if he has to create a table each time there is a new line/column that requires it, chance is that it'll become a problem quickly.
(I haven't found yet a method to put something in a given cell of a table at the creation of a new line, I'm also open on that point)
I was wondering if there are best practices to apply in this kind of case, and I am looking for advices too.
If you already had to treat something similar to this, how did you do?
Thanks in advance for your answers
Cordially,
Zawarudio
Note : The example of table here is insanely stupid, and even I don't even know what it's talking about. It was just to put informations in the tables, and have absolutely no link with what I'm trying to do.
If you were lost by the distances/times/whatever, sorry about that
I had some vacations so I didn't work on that question before now.
I just found a way that I felt was relevant, so I come here to share my answer
Note that I only worked on an unknown number of merged rows at the moment, so this answer will only be about that, though I believe it is the same. Also note that I'm on Word 2010. I don't know if rows/column behavior changed in 2013 or will change in the future. (well, obviously)
The big problem was that a merged row cell will only have a value of the first row of the merged row. Let's take a simple example
This table has 2 rows and 2 columns. We fused the rows of the 1st column.
table.Rows.Count will return 2, so will table.Columns.count.
table.cell(1,1).Range.text will return the content of the merged rows.
We would like table.cell(2,1).Range.text to return the value of the merged row, but VBA tells us here that this value doesn't exist.
There is no problem with table.cell(1,2).Range.text and table.cell(2,2).Range.text.
With values, that means that our table with merged rows is pretty equals to that
Where each empty cell would generate an error 5941.
How to resolve the problem?
Sub ReadAllRows()
Dim NbRows As Integer
Dim NbColumns As Integer
Dim i, j As Integer
Dim SplitStr() As String
Dim col1 as String
Dim col2 as String
Dim col3 as String
Dim col4 as String
'note : my table here is a public value that i get thanks to bookmarks
NbRows = table.Rows.count
NbColumns = table.Columns.count
For i = 3 To NbRows
'We put each value of each columns in a dim
'We do that to remember previously entered row value if the application encounters an error
'Because of merged rows, some cells on each row will not exist and return an error
'When the application encounters an error, it just proceeds to next column
'As previous existing value of this column was stocked in a Dim, we can get the full row at the end of the column loop
For j = 1 To NbColumns
On Error GoTo ErrorHandler
SplitStr = Split(table.Cell(i, j).Range.Text, Chr(13))
Select Case j
Case 1:
col1 = SplitStr(0)
Case 2:
col2 = SplitStr(0)
Case 3:
col3 = SplitStr(0)
Case 4:
col4 = SplitStr(0)
'ect...
End Select
NextRow:
Next j
'We have here all the values of the line
MsgBox "col1: " & col1 & Chr(10) & _
"col2: " & col2 & Chr(10) & _
"col3: " & col3 & Chr(10) & _
"col4: " & col4 & Chr(10)
Next i
'This Error handler will skip the whole Select Case and thus will proceed towards next cell
ErrorHandler:
If Err.Number = 5941 Then
Err.Clear
Resume NextRow
End If
End Sub
That way, when a cell doesn't exist, that mean the row if merged. Meaning we want the last known value of the row. Since we skip the whole select when row is unknown, the value of the Dim isn't changed while we do get right the value of not merged rows.
This isn't rocket science, but I first began with a simple On Error Resume Next, and with that, non-existing rows simply had the value of last existing row, so I also had to work on a function that would try to get the good value for each cell of each row...
Note that I did things the ugly way here, but you can use a one dimensionnal arrays to stock an entire row the way Word is supposed to understand it, or you can even get a two dimensionnal array stocking your whole table in it a way Word understands
Well, I hope it helps someone, someday!
Cordially,
Zawarudio
I think there must be an existing Q/A about this but I didn't find it using a quick search, so for now...
One thing you can do is iterate through the cells of the range of the table. Like this:
Sub iterTable()
Dim r As Range
Set r = ActiveDocument.Tables(1).Range
For i = 1 To r.Cells.Count
Debug.Print r.Cells(i).RowIndex, r.Cells(i).ColumnIndex, r.Cells(i).Range.Text
Next
End Sub
As long as you have predefined texts that will allow you to detect your "Destination" groups, that should be enough for you to make progress...

Repeat a column list in Excel until end of sheet

I feel like this is extremely simple, but for some reason, this is not an easy thing to do in Excel. Basically I have a vertical set of values running down a column ranging from 1 to 3, but they are random. However this same sequence will repeat every 60 rows. I need the sequence to just repeat itself every 60 rows, as the data file I'm working on is tens of thousands of rows and I don't feel like copying and pasting that many times. The values run from M2:M61.
Is there a simple VBA code to loop this column?
Alternatively, is there an equation that can do this? I tried using Index, but don't think I was specifying the row or columns correctly
=INDEX($M$122:$M$181,ROUNDUP(ROWS(I$122:I132)/60,0),13)
If you wanted some code to do it, maybe this will give you some ideas. It assumes that your first lot of 60 values have been entered in A1:A60 and reads them into an array, and then loops up to the number of loops (I used 12000) copying the values in by steps of 60.
Sub Repeat60Rows()
Dim ListArray As Variant
Dim Loopcounter As Long
Dim MyRange As String
ListArray = Worksheets("Sheet2").Range("A1:A60").Value
For Loopcounter = 1 To 12000 Step 60
MyRange = "A" & Loopcounter & ":A" & Loopcounter + 59
Worksheets("Sheet2").Range(MyRange) = ListArray
Next Loopcounter
End Sub
I learned a little more and realized, because this is a repeating set of 60 numbers, I could just use a simple =OFFSET(M62, -60, 0) formula and I could just paste down. I'm sure there's probably an easier way to automate this with VBA, but I'm unsure as to how to do that.
In M182
=OFFSET(M$121,MOD(ROW()-2,60)+1,0)
and fill down

VBA Macro: Trying to code "if two cells are the same, then nothing, else shift rows down"

My Goal: To get all data about the same subject from multiple reports (already in the same spreadsheet) in the same row.
Rambling Backstory: Every month I get a new datadump Excel spreadsheet with several reports of variable lengths side-by-side (across columns). Most of these reports have overlapping subjects, but not entirely. Fortunately, when they are talking about the same subject, it is noted by a number. This number tag is always the first column at the beginning of each report. However, because of the variable lengths of reports, the same subjects are not in the same rows. The columns with the numbers never shift (report1's numbers are always column A, report2's are always column G, etc) and numbers are always in ascending order.
My Goal Solution: Since the columns with the ascending numbers do not change, I've been trying to write VBA code for a Macro that compares (for example) the number of the active datarow with from column A with Column G. If the number is the same, do nothing, else move all the data in that row (and under it) from columns G:J down a line. Then move on to the next datarow.
I've tried: I've written several "For Each"s and a few loops with DataRow + 1 to and calling what I thought would make the comparisons, but they've all failed miserably. I can't tell if I'm just getting the syntax wrong or its a faulty concept. Also, none of my searches have turned up this problem or even parts of it I can maraud and cobble together. Although that may be more of a reflection of my googling skill :)
Any and all help would be appreciated!
Note: In case it's important, the columns have headers. I've just been using DataRow = Found.Row + 1 to circumvent. Additionally, I'm very new at this and self-taught, so please feel free to explain in great detail
I think I understand your objective and this should work. It doesn't use any of the methodology you were using as reading your explanation I had a good idea how to proceed. If it isn't what you are looking for my apologies.
It starts at a predefined column (see FIRST_ROW constant) and goes row by row comparing the two cells (MAIN_COLUMN & CHILD_COLUMN). If MAIN_COLUMN < CHILD_COLUMN it pushes everything between SHIFT_START & SHIFT_END down one row. It continues until it hits an empty row.
Sub AlignData()
Const FIRST_ROW As Long = 2 ' So you can skip a header row, or multiple rows
Const MAIN_COLUMN As Long = 1 ' this is your primary ID field
Const CHILD_COLUMN As Long = 7 ' this is your alternate ID field (the one we want to push down)
Const SHIFT_START As String = "G" ' the first column to push
Const SHIFT_END As String = "O" ' the last column to push
Dim row As Long
row = FIRST_ROW
Dim xs As Worksheet
Set xs = ActiveSheet
Dim im_done As Boolean
im_done = False
Do Until im_done
If WorksheetFunction.CountA(xs.Rows(row)) = 0 Then
im_done = True
Else
If xs.Cells(row, MAIN_COLUMN).Value < xs.Cells(row, CHILD_COLUMN).Value Then
xs.Range(Cells(row, SHIFT_START), Cells(row, SHIFT_END)).Insert Shift:=xlDown
Debug.Print "Pushed row: " & row & " down!"
End If
row = row + 1
End If
Loop
End Sub
I modified the code to work as a macro. You should be able to create it right from the macro dialog and run it from there also. Just paste the code right in and make sure the Sub and End Sub lines don't get duplicated. It no longer accepts a worksheet name but instead runs against the currently active worksheet.