Searching data from one spreadsheet into another - excel

I'm making a macro that is supposed to check for a set of values in an input list from the user. If the values from my source list are NOT in the user input, they have to be copied into a different spreadsheet. The macro runs without errors, but it won't filter any results. It just copies everything.
This is the code:
Sub CheckRow()
For i = 2 To Application.CountA(Worksheets("Source").Range("A:A")) 'Loop through rows
Set rgFound = Worksheets("Input").Range("A:A").Find(Worksheets("Source").Range("A" & i).Value, LookAt:=xlWhole) 'Find the value from the source list in the Input List
If rgFound Is Nothing Then 'If there is no match it goes to output
Worksheets("Output").Range("A" & Application.CountA(Worksheets("Output").Range("A:A")) + 1).Value = Worksheets("Source").Range("A" & i).Value 'Copy the value beow any existing values
End If
Next i
End Sub
I will appreciate any suggestions you have to offer.

Your condition should be If Not rgFound Is Nothing Then (the Not is missing in your code). Basically, the Find method doesn't find anything and therefore everything is copied.
I also advise you to use Option Explicit at the top of your code sheet. This would alert you to the use of the variable j in Find(Worksheets("Source").Range("A" & j). I think you are looking for A & i. However, since j appears to have a value of 0 your code shouldn't copy anything because there is no row 0. Using Option Explicit would force you to declare all variables, eliminating guessing games like this one when reading your code. Since you are the one to read it most of the time you would also be the prime beneficiary of the improvement.

Fixed. It seems that the Find method thinks that Value and ="Value" are two different things. Once I changed all the formula cells to plain text my code worked like a charm.

Related

How to check if hyperlink target's name contains a specific string?

I have cells in a workbook that link to cells that are named (individually). The cell names all start with "Filter", with some string after that (e.g. FilterSubcategory1").
If the user clicks one of the links, it takes them to the linked cell and then filters another sheet based on where the target was (using .Address at the moment, all works fine). As they all have the same starting string in their name, is it possible to filter if the target name starts with "Filter" instead? This would make my code far shorter rather than listing all relevant named ranges.
It would look something like this (for illustrative purposes, not my full or optimised code):
If Target.Range.Name = "Filter" & "*" Then
'rest of code, do the filtering
End If
or:
If InStr(Target.Range.Name, "Filter") > 0 Then
'rest of code, do the filtering
End If
Please, try the next function:
Function IsFilter(cel As Range) As Boolean
If cel.Hyperlinks.Count = 0 Then Exit Function
If InStr(cel.Hyperlinks.SubAddress, "Filter") > 0 Then IsFilter = True
End Function
The above function can be use in the next way:
Sub testIsFilter()
Dim testCell As Range
Set testCell = ActiveCell 'it may be any cell (resulted from a iteration or not)
If IsFilter(testCell) Then
'rest of code, do the filtering
End If
End Sub
Please, test it and send some feedback.
So, after trying other users' solutions (very helpful in the lead up to the solution), I managed to solve it in a different way. Some hyperlinks linked to themselves (in fact, all the ones that filter do), some linked to merged cells too, so this was the method I used for any cells that linked to themselves:
FltrStr = "='" & ActiveSheet.Name & "'!" & ActiveCell.Address 'builds up the cell address from scratch, allowing for a merged cell being selected
Set FltrRng = Range(FltrStr) 'converts the string into the actual range needed, important for the next line
FltrName = FltrRng.Name.Name 'gets the name of the range, reporting the given name if it exists, lookup .name.name if you are unsure why two .names are needed
I can then use this to check if the target range has a name which starts with whatever I want, here 'Filter':
If InStr(FltrName, "Filter") > 0 Then
'rest of code, do the filtering
End If
Probably not the prettiest/most efficient way to do it, but it works. May be worth defining the types of the variables (FltrStr, FltrRng, FltrName) explicitly at the start of the sub to avoid any type mismatch errors, but I haven't defined them at the moment and they are working fine. (Bad practice, I know!)

VBA - Excel - Finding the cell location of a userform TextBox populated by a for i loop?

What do I need to know?
How do I get the location of the data that a textbox is displaying? How do I know where it is?
What am I doing?
I have some code that loops through i and assigns it a value then pulls the cell value from a sheet based on i....so (i, 2) is simply: Row i from Column 2. This is then displayed in a userform Textbox.
What I want to do?
Add a dbl_click event, so that someone can double click on the textbox and be sent to the sheet/row/column that is being displayed. I have no issue creating the dbl_click event, but my problem appears to be how to get the cell location being displayed?
If it is relevant, this is my code for the loop:
Dim code as String
code = search.Value
For i = 2 To LastRow
If Sheet1.Cells(i, 9).Value = code Then
ssn1.Text = Sheet1.name
hb11.Text = Sheet1.Cells(i, 9).Value
End If
Next i
This is a snippet, as this goes on for awhile, hb11 runs though to hb37 - didn't see any reason to paste it all here.
The problem is, that the loop continues through, across multiple sheets as well, finding all examples of "code" so i keeps changing, after it has written the data to the TextBox - so I can't rely on (i, 9) from the loop.
I have gotten this far in terms of code:
Sub bt11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If hb11.Value <> ("") Then
Application.Goto Reference:=Sheet1.Range(hb11)
End If
End Sub
However this appears to be relying on the value of hb11, rather than the cell location.
I know this is a dumb question, I know, but I just can't seem to find the answer?
I get the feeling that it lies in:
Dim cell as Range
Then:
Set cell = hb11.something
But I have been through the list, cell/range gives a mismatch, and don't actually exist in the list. There is no 'linked cell' as I thought that might do it...
I am a bit lost.
Profit from using the .Tag property
I'm assuming each of your 27 textboxes refers to exactly one source range address which consists of sheetname, row and column (or column character).
If so you can profit from assigning a combined reference string (e.g. "Sheet22" & "," & i & "," & 9) to a textbox'es ►.Tag property during the initializing loop, e.g. in a comma separated way like perhaps
hb11.Tag = "Sheet22,17,9" ' << i.e. sheet name, row 17, column 9
I think it'll be easy to get all data from there:
Dim src: src = split(hb11,",")
Application.Goto Reference:= _
ThisWorkbook.Worksheets(src(0)).Range(Cells(Val(src(1)), Val(src(2))).Address), Scroll:=True
Too many hours later, I have worked this out.
Thanks to T.M. for the idea about re-writing the data out of a stored place.
Outside of any sub, I created a String - right at the top.
Dim ac1 As String
Inside my loop, I simply gave ac1 the value of i,
For i = 2 To LastRow
If Sheet1.Cells(i, 9).Value = code Then
ssn1.Text = Sheet1.name
hb11.Text = Sheet1.Cells(i, 9).Value
ac1 = i
End If
Next i
This works, because you only run through this loop, IF code exists, since the list is unique, code only exists once. So you only go into the loop once, and when you do, i = the row.
Then using T.M.'s idea, I wrote out:
Application.Goto Reference:=Sheet1.Range("A" & ac1)
This is a range reference that Goto can handle.
The advantage of this method is, because I am searching multiple sheets with multiple Textboxes, I only need ac1 for a whole sheets worth of Textboxes.
Hope this helps someone in the future.

Trying to Remove Duplicates based on first column

I am currently trying to remove rows from column A to column V based on duplicates found in column A.
my current formula is:
Workbooks(TgtWB).ActiveSheet.Range("A15:V500").RemoveDuplicates _
Columns:=Array(1), Header:=xlYes
My header is located on row 15.
the error i am getting is
Application-defined or object-defined error
I have tried switching ActiveSheet with worksheet("xxx") but still doesn't seem to work either. i'm not sure what i'm doing wrong here.
Try (note worksheetS, not worksheet),
Workbooks(TgtWB).worksheetS("xxx").Range("A15:V500").RemoveDuplicates Columns:=1, Header:=xlYes
'or,
ActiveSheet.Range("A15:V500").RemoveDuplicates Columns:=1, Header:=xlYes
If TgtWB is open, it may or may not contain the ActiveSheet. Each open workbook does not have an ActiveSheet. There is only one ActiveSheet for the application instance. ActiveSheet is not a property of the Workbooks collection.
Using built in functionality is great, unless you're a beginner like myself and the .Applications and .Worksheets get overwhelming and confusing. For a small data set, such as columns A through V (depending obviously on how many rows you have), a loop and if-statement not only can work well, but can be good practice as well! Something like this may work well:
Dim CurrentValue, LastValue As Variant
LastValue = ""
For I = 1 To 500
CurrentValue = Sheets("Sheet 1").Range("A" & i).Value
If CurrentValue = LastValue Then
Sheets("Sheet 1").Range("A" & i & ":V" & i).Clear Contents
Else
LastValue = CurrentValue
End If
Next i
This will loop through every row, ask if the current value in the cell is the same as the one previously observed (except the first one, the first one will automatically be saved by nature), and if it has been, it will clear the contents of the row. If it's not the same, it will assign it to the new variable and begin looking for new ones.
There are two drawbacks with this method that can be solved by simply adapting the code to your needs:
Non-Sequential Items: If the values that are duplicates are not sequential, the code won't kick them out. At that point I recommend using an application code or a dictionary. Dictionaries are infinitely useful for storing unique data entries and skipping duplicates.
Deleting Rows: When you delete rows in a loop it messes up your loop, throwing off the order of your incrementer. The best way to combat this is by first clearing the columns then having your code loop for empty rows and delete them outside of your loop.
This is very basic but something I've found greatly helpful as a beginner and hopefully other beginners and yourself can learn something from it.
Happy Coding!

Range.End not returning Long; going to end of spreadsheet, not stopping at first blank cell

I am using the following code to find the last row number in a column of data:
Dim LR as Long
LR = Range("A4").End("xlDown").Row
There are no blank cells between data in the A column. I am getting a type mismatch error. When I try to select the last row, I get an object error.
I am using the previous code because this code:
Workbooks(JunxureFile).Sheets("Sheet1").Range("A4", "A" &
Range("A4").End(xlDown).Row).Copy
did not stop after the first blank cell, and instead copied the entire column (to the max rows Excel allows).
Every example I've seen of Range.End implies it should not be acting this way, so I'm not sure what the problem is. I'm going to try just using rows.count for now, but I'd like to know what the issue with this code is. How do I change my code for it to work?
EDIT2:
I just tried
ActiveSheet.Range("E1").Value = Rows.Count
to see that Rows.Count is getting me 1048576, so it's still selecting way too many rows. I'm going to try copy and pasting my data to a different workbook to see if that helps (EDIT3: it did not).
This
Workbooks(JunxureFile).Sheets("Sheet1").Range("A4", "A" & Range("A4").End(xlDown).Row).Copy
might fail because you did not specify the correct worksheet for the second range like
Workbooks(JunxureFile).Worksheets("Sheet1").Range("A4", "A" & Workbooks(JunxureFile).Worksheets("Sheet1").Range("A4").End(xlDown).Row).Copy
or in a shorter way
With Workbooks(JunxureFile).Worksheets("Sheet1")
.Range("A4", "A" & .Range("A4").End(xlDown).Row).Copy
End With
Explanation:
If you use Range("A4") without specifying in which worksheet this range is, VBA guesses which sheet you mean and in most cases it is the same like writing ActiveSheet.Range("A4") but this might be easily the wrong sheet. So always specify which worksheet you mean the range to be in like: Workbooks(JunxureFile).Worksheets("Sheet1").Range("A4")

Performance of deleting many rows from an autofilter in VBA

I would like to know if there is a faster way do this than the code I am using. I got the code using xlUp from the recorder.
rCnt = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.Range("$B$1:$J" & rCnt).AutoFilter Field:=5, _
Criteria1:=Application.Transpose(arrCodes), Operator:=xlFilterValues
Rows("2:" & rCnt).Delete Shift:=xlUp
And actually, if there was some way to flip the filter, I wouldn't need to delete at all as this is a temporary table that I copy from. However, all my research has failed to find a way to do
Criteria1:=Application.Transpose(<>arrCodes)
and arrCodes has too many elements to list in the filter. And the stuff that is not in arrCodes is way too numerous to make an array from. Thanks.
If you want to just use Excel UI and not formulas or VBA, you can do the following simple steps to get an "inverse" filter. This could then be ported to VBA if needed:
Apply the filter with the opposite conditions
Color those cells in one column (either font or background)
Clear the filter
Filter again but this time by cells in that column without color
Copy those results where you want them
This will not work well if the column already has some background colors. If that is the case, you can add a new column and color it. If this is in VBA, you could automate those steps. There are limits, but this is quick and simple if it applies.
I've had success in the past with building then deleting a range. You can combine ranges with Union(). I've attached a bit of example code, it's not wonderful but it shows the basic concept. This example deletes rows with odd numbers in column A in rows 2 through 11.
Public Sub DeleteRows()
Dim deleteThis As Range
For i = 2 To 11
If Sheet1.Cells(i, 1).Value Mod 2 = 1 Then
If deleteThis Is Nothing Then
Set deleteThis = Sheet1.Rows(i)
Else
Set deleteThis = Union(deleteThis, Sheet1.Rows(i))
End If
End If
Next i
deleteThis.Delete xlShiftUp
End Sub

Resources