Vlookup doesn't seem to cooperate - vba

I have the following Code for bank reconciliation which involves checking each cell in column D of sheet1 (bank statements) and see if it exists in column M of Sheet 2. If it doesn't flag it by saving it to arrOutput.
Being a new user, and because I could not attach the spreadsheet, I have links to what Sheet 1 and 2 look like.
Sheet1
Sheet2
Sub abc_3()
Dim i As Long, ii
Dim arrBank As Range
Dim arrAccounting As Range
Dim arrOutput
Dim temp As Variant
' setting bank transaction into range
Set bank = ActiveWorkbook.Sheets("Sheet1").Range("D25:E25" & Cells(Rows.Count, "D").End(xlUp).Row)
' setting accounting transactions into range
Set books = ActiveWorkbook.Sheets("Sheet2").Range("M1:N1" & Cells(Rows.Count, "M").End(xlUp).Row)
'everytime time the program is run arrOutput must be cleared. 3000 is an arbitrary number I chose because there will likely never be a higher number of transactions than this.
ReDim arrOutput(1 To 3000, 1 To 2)
ii = 0
' The main function of the program.. looping through every bank transaction checking if it can be found in accounting transactions,
' if it cannot be found, i.e error is thrown then save the cell to arrOutput because it needs to be flagged for checking.
' if it can be found, then ignore and check next bank transaction.
' Currently, the procedure is supposed to compare only Sheet1 credit transactions with Sheet2 credit transactions, therefore filter only credit transactions.
For Each cell In bank.Cells 'problem here is comparing both Column D and E of Sheet 1 whereas it should be comparing only column D.
If cell <> "" Then 'this is to avoid checking non-credit transactions.
On Error Resume Next
temp = Application.WorksheetFunction.VLookup(cell, books, 2, False)
If Err.Number <> 0 Then
MsgBox "Bank Transaction " & cell & " could not be found in Books Transaction history"
arrOutput(ii, 1) = cell
arrOutput(ii, 2) = ""
ii = ii + 1
End If
End If
Next
'all cells checked then dump arrOutput to range "L4" for reading
Range("l4").Resize(3000, 2) = arrOutput
bank.ClearContents
books.ClearContents
End Sub
The problem is that on every cell I get MSG "Bank Transaction " & cell & " could not be found in Books Transaction history". Consequently, Every cell gets saved to arrOutput and saved to Sheets("Sheet3").Range("L4") making me wonder whether Vlookup is not cooperating or I didn't setup the error handler correctly.
Looking forward to getting some help.. been stuck on this for too long. Thank you in advance.

1) you should qualify the ranges. 2) :E25 should be :D and :N1 should be :M. 3) Use Option Explicit and use the variables you declared (you declare some variable names but then you use other names...). 4) Finally, use Find instead of VLookup, since you only want to check the existence of the value, not a corresponding other value.
Option Explicit
Sub abc_3()
Dim bank As Range, books As Range, cell As Range
With ActiveWorkbook.Sheets("Sheet1")
Set bank = .Range("D26:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With ActiveWorkbook.Sheets("Sheet2")
Set books = .Range("M2:M" & .Cells(.Rows.Count, "M").End(xlUp).Row)
End With
Dim ii As Long, x As Range, arrOutput(1 To 3000, 1 To 2)
For Each cell In bank.Cells
If Trim(cell.Value) <> "" Then
Set x = books.Find(cell.Value, , xlValues, xlWhole)
If x Is Nothing Then
ii = ii + 1
arrOutput(ii, 1) = cell.Value
MsgBox "Bank Transaction " & cell.Value & " could not be found in Books Transaction history"
Else
x.Value = ""
End If
End If
Next
ActiveWorkbook.Sheets("Sheet3").Range("l4").Resize(3000, 2) = arrOutput
End Sub

Related

Replacing hard value cells with subtotal formula - VBA

Essentially, our system runs off an expenditure listing of cost headings, with a subtotal on each. The issue being we adjust the data, so need to go through and manually turn the hard value subtotals into subtotal formula in each heading; which over hundreds of different headings, with variable numbers of costs, can be tedious and time consuming.
I've built a basic test example whereby for every instance of A (Heading), where the associated B has a value (an element of data from the system for a line of expenditure), the costs (C) will be subtotalled (109,...), replacing the hard copied value.
Sub insertsubtotal()
Dim cell As Range
Dim sumrange As Range
Set cell = Cells(Cells.Rows.Count, "A")
Do
Set cell = cell.End(xlUp)
Set sumrange = cell.Offset(1, 1).CurrentRegion.Offset(1, 2).Resize(cell.Offset(1, 1).CurrentRegion.Rows.Count - 1, columnsize:=1)
If sumrange.Cells.Count > 1 Then
sumrange.End(xlDown).Offset(2, 0).Formula = "=SUBTOTAL(109," & sumrange.Address & ")"
Else
sumrange.Offset(2, 0).Formula = "=SUBTOTAL(109," & sumrange.Address & ")"
End If
Loop Until cell.Row = 1
End Sub
This works whereby the first heading is in A1, and the cost data in column C as below...
However, where I'm struggling is, I need to amend the process to have the first 5 rows ignored (first heading being on 6), and the cost data and subtotal that needs replacing being in column M.
Any help would be appreciated.
Using SpecialCells to divide the UsedRange in Columns("C") into blocks of contant values, will allow you to easily identify and subtotal your data blocks.
Sub insertsubtotal()
Dim Source As Range, rArea As Range
With Worksheets("Sheet1")
On Error Resume Next
Set Source = Intersect(.UsedRange, .Columns("C")).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "No data found", vbInformation, "Action Cancelled"
Exit Sub
End If
For Each rArea In Source.Areas
rArea.Offset(rArea.Rows.Count).Cells(2).Formula = "=SUBTOTAL(109," & rArea.Address & ")"
Next
End With
End Sub

How can you detect text entry throughout multiple sheets and manipulate cells below it?

I am trying to figure out how to add some cell values together from different sheets but I don't know what the cells references are as they vary!
Basically the values i need will appear 2 rows below some certain text. So I was looking for a formula that searches multiple sheets, finds the specific text, goes 2 rows below then adds the values together.
Here's something I hope you can adapt to your situation by changing the sheet and row and column range, the text to look for, and the destination of the total.
Sub findfvalues()
Dim rowValue
Dim total
total = 0
For r = 1 To 25 'update this to suit your needs
For c = 1 To 25 'update this to suit your needs
If Cells(r, c).Value = "f" Then 'update "f" to search for what you want
rowValue = r + 2
total = total + Cells(rowValue, c).Value
End If
Next
Next
Cells(30, 1).Value = total 'update this to suit your needs
End Sub
So we just check every cell for the "f" and if we find it, we add the value to a running total. Display the total at the end.
This will look in each worksheet, and if your text is found, add the value that's two rows below to a running total:
Sub find_Values()
Dim ws As Worksheet
Dim findStr As String
Dim foundCell As Range
Dim total As Long
findStr = "my Text"
For Each ws In ActiveWorkbook.Worksheets
Set foundCell = ws.Cells.Find(what:=findStr)
If Not foundCell Is Nothing Then
total = total + foundCell.Offset(2, 0).Value
End If
Next ws
Debug.Print "The value is: " & total
End Sub

How to pause macro, then do my stuff and continue/resume from where I left?

I got data in one sheet form B2:ZY191, and I want to copy each row (B2:ZY2,B3:ZY3, and so on till B191:ZY191) to another workbook worksheet for analysis. Now while doing so I sometimes need to stop and mark my results in between and then continue from where I left. For example, I started the macro and it copied from B2:ZY2 to B52:ZY52 then I pause the macro & mark my results. Now I want to continue from B52:ZY52 onwards then again if I want to stop after copying data till B95:ZY95 I should be able to pause the macro, mark my result and continue from B95:ZY95 thereon. I should be able to do this as many times as I want.
If provided with buttons like start, pause and resume would be very helpful.
you could adopt the following workaround:
choose the "sets" you want to virtually divide your data range into
let's say:
set#1 = rows 1 to 20
set#2 = rows 21 to 30
... and so on
mark with any character in column "A" the final rows of all chosen sets
so you'd put a "1" (or any other character other than "|I|" or "|E|" - see below) in the following cells of column "A" (i.e. the one preceding your data range):
A21
A31
..., and so on
(since your data starts at row 2 then its ith row is in worksheet row I+1)
then you put the following code in any module of your data range workbook:
Option Explicit
Sub DoThings()
Dim dataRng As Range, rngToCopy As Range
'assuming Analysis.xlsx is already open
Set dataRng = Worksheets("BZ").Range("B2:ZY191") '<--| this is the whole data range. you can change it (both worksheet name and range address) but be sure to have a free column preceeding it
Set rngToCopy = GetCurrentRange(dataRng) '<--| try and set the next "set" range to copy
If rngToCopy Is Nothing Then '<--| if no "set" range has been found...inform the user and exit sub!
MsgBox "There's an '|E|' at cell " _
& vbCrLf & vbCrLf & vbTab & dataRng(dataRng.Rows.Count, 1).Offset(, -1).Address _
& vbCrLf & vbCrLf & " marking data has already been entirely copied" _
& vbCrLf & vbCrLf & vbCrLf & "Remove it if you want to start anew", vbInformation
Exit Sub
End If
With rngToCopy
Workbooks("Analysis").Worksheets("Sheet1").Range(.Address).value = .value
End With
End Sub
Function GetCurrentRange(dataRng As Range) As Range
Dim f As Range
Dim iniRow As Long, endRow As Long
With dataRng
With .Offset(, -1)
Set f = .Resize(, 1).Find(what:="|E|", lookat:=xlWhole, LookIn:=xlValues) '<--| look for the "all copied" mark ("|E|")
If Not f Is Nothing Then Exit Function '<--| if "all copied" mark was there then exit function
Set f = .Resize(, 1).Find(what:="|I|", lookat:=xlWhole, LookIn:=xlValues) '<--| look for any "initial" mark put by a preceeding sub run
If f Is Nothing Then '<--|if there was no "initial" mark ...
iniRow = 1 '<--| ...then assume first row as initial one
Else
iniRow = f.row - .Cells(1).row + 1 '<--| ... otherwise assume "marked" row as initial one
f.ClearContents '<--| and clear it not to found it the next time
End If
endRow = .Cells(iniRow, 1).End(xlDown).row - .Cells(1).row + 1 '<--| set the last row as the next one with any making in column "A"
If endRow >= .Rows.Count Then '<--| if no mark has been found...
endRow = .Rows.Count '<--| ...set the last row as data last row...
.Cells(endRow, 1).value = "|E|" '<--|... and put the "all copied" mark in it
Else
.Cells(endRow, 1).ClearContents '<--| ...otherwise clear it...
.Cells(endRow + 1, 1).value = "|I|" '<--| ... and mark the next one as initial for a subsequent run
End If
End With
Set GetCurrentRange = .Rows(iniRow).Resize(endRow - iniRow + 1) '<--| finally, set the range to be copied
End With
End Function
and make it run as many times as you need: after each time it ends and you can mark your result and then make it run again and it'll restart form where it left
you can use Stop and Debug.Print to achieve the desired results when placed within your code. For example if you're looping through a range, add the statement of choice with an if statement:
for a = 1 to 150
if a = 20 or a = 40 then
debug.Print "The value of a is: " & a.value 'or whatever you want to see
end if
next
This will print to the immediates window, or use stop to pause your code in a strategic place in the same manner.
I dont understand what you mean by buttons? They surely aren't a good idea as the code will run too fast?

Looping over list of items, showing only those that match criteria

I'm in the need of your help to solve the basic exercise I encountered during the course of learning Excel VBA. So, here it is:
There is a list of rollercoasters, where one column represents the name of the rollercoaster, whilst another column its type. I have to loop down the list, until the empty cell, selecting only those rollercoasters, the type of which is "Wooden". The sub should end with a message box displaying all rollercoasters' names, that matched our "Wooden" criterion (every line of msgbox contains one name).
So, anyone could advise a new learner how to cope with the above...?
This will run on the first 1000 rows where column a is the rollercoasters and column b is the type. you can cahnge the number 1000 to another number or xldown if you desire.
Sub Macro1()
'
Dim Rollers As String
For i = 1 To 1000
If Cells(i, 2) = "Wooden" Then Rollers = Rollers & vbNewLine & Cells(i, 1).Value
If Cells(i, 1) = "" Then MsgBox (Rollers): End
Next i
'
End Sub
I would add to Balinti's answer. This will get you the last row to use instead of hardcoding 1000
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Then you would have a loop that looked like this
For i = 1 To LastRow
Next i
MsgBox Rollers

Create a VBA macro that Find and Copy?

I need a little bit help with a macro of Excel.
I need to create a macro that automatically find users and copy the values that i have in an other Sheet:
I have one sheet with values that contains the Users and their Kills and Deaths, I create 3 sheets more (3 different groups of users), and I need that the macro copy values automatically finding the users and copying values.
Images to describe it better:
----(Copy this values on)----->
You don't need a macro for this, using the worksheetfunction VLOOKUP is sufficient.
As an example, if you have your headers in row 1 and users in column A, what you'd put into cell B2 (the number of kills for the first user) would be =VLOOKUP($A2;Values!$A$2:$C$9;2;FALSE) and C2 would be =VLOOKUP($A2;Values!$A$2:$C$9;3;FALSE).
The arguments for the function (which you can also find in the linked document) is:
First, the value you're looking for, in your case whatever is in A2
Next the array of values which you want to return a result from - vlookup will only look through the first column, but since you want to return results from the other columns we include columns A:C in the formula.
What column in the range you search to return the result from for kills it is column 2, for deaths column 3.
Finally whether you want to have an exact match (false) or if an approximate one is ok (true).
If I understand what you're after, you should be able to do this with VLOOKUPs
(No VBA necessary)
The following source code solve your problem.
Option Explicit
Dim MyResultWorkbook As Workbook
Dim ValuesWorksheet As Worksheet
Dim SniperWorksheet As Worksheet
Dim ARsWorksheet As Worksheet
Sub CopyResult()
Set MyResultWorkbook = ActiveWorkbook
Set ValuesWorksheet = MyResultWorkbook.Sheets("Values")
Set SniperWorksheet = MyResultWorkbook.Sheets("Sniper")
Set ARsWorksheet = MyResultWorkbook.Sheets("Ars")
Dim SniperLastRow As Long
Dim ARLastRow As Long
Dim RowPointer As Long
Dim ValuePointer As Long
ValuePointer = 2
'Update the Sniper worksheets
SniperLastRow = SniperWorksheet.Cells(SniperWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To SniperLastRow
Do While (SniperWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
SniperWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
SniperWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
'Update the Ars worksheets
ARLastRow = ARsWorksheet.Cells(ARsWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To ARLastRow
Do While (ARsWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
ARsWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
ARsWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
End Sub