.Find method not searching in order - excel

Can anyone explain why the string in D2 is being built out of order in the first loop?
This is only happening for the first search value, Dom. The rest of the strings are being built in the order in which they appear (see Column B). I treid adding SearchDirection:= xlNext but the output remained the same with or without that bit of code.
In the photo, Column A:B are the raw data and Column C:D are the output from macro.
The cell in question is D2. It should show USD/EUR/GBP instead of EUR/GBP/USD
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim FoundName As Range, SearchRange As Range, Names As Range, Name As Range
Dim MyString As String, i As Long
ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("C1"), Unique:=True
Set SearchRange = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
Set Names = ws.Range("C2:C" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)
For Each Name In Names
Set FoundName = SearchRange.Find(Name, SearchDirection:=xlNext)
For i = 1 To Application.WorksheetFunction.CountIf(SearchRange, Name)
MyString = MyString & FoundName.Offset(, 1) & "/"
Set FoundName = SearchRange.FindNext(FoundName)
Next i
Name.Offset(, 1) = Left(MyString, Len(MyString) - 1)
MyString = ""
Next Name

According to Microsoft documentation about the Range.Find method, the After parameter is:
The cell after which you want the search to begin. This corresponds to the position of the active cell when a search is done from the user interface. Notice that After must be a single cell in the range. Remember that the search begins after this cell; the specified cell isn't searched until the method wraps back around to this cell. If you do no specify this argument, the search starts after the cell in the upper-left corner of the range.
(Emphasis mine)
In your code, you set the range you're searching like:
Set SearchRange = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
which means that the first cell actually searched will be Range("A3"). There are two ways of fixing this:
Expand the search range to include "A1", so the default start is "A2"
Specify the After parameter as the last cell in the range. Since the search wraps back around to the first cell after reaching the last cell.
In your scenario, I believe the simplest solution would be (1). This can be done by simply adjusting your code line to read:
Set SearchRange = ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)

Related

If value matches from list, insert corresponding value below

Attempting to write some vba but not having much luck. I have column A with a whole list of values that I am counting and looping through. For Each value in column A, there can be a match in range C:D. If a value in column A matches a value in column C. I want to insert the corresponding value in column D below the Column A value. I am not too certain on what my IF then statement should look like. I have my counter and loop... I am just unsure where to go with the middle portion of the code.
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ef
IF (UNSURE WHAT TO PLACE HERE!) THEN
Next i:
End Sub
Edit: adding sample data
Sample Data screenshot
In this example, I would like to insert a new row under the value in "A" where A=C. ie. Range in column "A" = Range in Column "C". I would like to then insert the value from "D". The new order in rows 4-6 would be:
Range
Order Group 1
2604291
I already have written the code to manually move my sheets around to follow the specific order once I am able to get the names in said order.
I agree with #BigBen that the simpler approach would be to insert a formula in column D that only replicates the column A value when a match is detected. Such a formula would probably look like the following -
=IF($A1=$C1,$A1,"")
This would be copied into cell D2 of your column and copied down as far as needed.
However, if you did want to achieve this with VBA and I have noted you used the word insert a value (as opposed to simple enter a value or copy & paste a value) then this could be your approach -
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Dim i As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = ef To 1 Step -1
If wp.Range("A" & i).Value = wp.Range("C" & i).Value Then
wp.Range("D" & (i + 1)).Insert xlShiftDown
wp.Range("D" & (i + 1)).Value = wp.Range("A" & i).Value
Else
End If
Next i
End Sub
This approaches the problem in reverse by going up your column instead of going down. Note that by inserting your data, will cause each previous value to move down as well. If you don't want this, then simply erase the .Insert line and it will enter the value instead of inserting a cell.
Modify the below code and use:
Formula:
=IFNA(VLOOKUP(A1,$C$1:$D$5,2,0),"Missing")
VBA Code:
Option Explicit
Sub test()
Dim rngSearch As Range, rngFound As Range
Dim LastRowA As Long, LastRowC As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rngSearch = .Range("C1:D" & LastRowC)
For i = 1 To LastRowA
Set rngFound = rngSearch.Find(.Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not rngFound Is Nothing Then
.Range("B" & i).Value = .Range("D" & rngFound.Row).Value
Else
.Range("B" & i).Value = "Missing"
End If
Next i
End With
End Sub
Result:

Find a date in other sheet

I extract a date from sheet "A" to find in a sheet "B".
I have the same type of date in each sheet (type 7) and the date exists.
With the code below I have
Error 91 : Object variable or With undefined block variable
Sub SearchDate()
lastColTraining = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
lastLetterTraining = Split(Cells(1, lastColTraining).Address, "$")(1)
Set allTraining = Range("K3:" & lastLetterTraining & "7")
For Each training In allTraining.Columns
trainingDate = training.Rows(4)
With Worksheets("B")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
allDate = .Range("A2:A" & lastRow)
firstRowDate = allDate.Find(What:=trainingDate, After:=.Range("A" & lastRow)).Row
End With
Next training
End Sub
I scoured many forums and tried different solutions without finding an answer.
There are a few things going wrong here:
First: Declare your variables, it's even best to use Option Explicit on top of your module to actually make you not forget any. Otherwise VBA will try to make an educated guess which will be a Variant type of the date type.
Second I would try to avoid ActiveSheet but instead use a CodeName. For example Sheet1.Range("..."). This post on SO can clarify a thing or two on this matter.
Third, UsedRange is not the most reliable way to return a last used column. Instead I would go with something like:
With Sheet1 'The explicit sheet reference from the first point
lastColTraining = .Cells(1, .Columns.Count).End(xlToLeft).Column
End with
Fourth: You don't really need the column letter to refer to the column. There are other ways, for example using .Cells within a range. You could use:
With Sheet1 'The explicit sheet reference from the first point
lastColTraining = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set allTraining = .Range(.Cells(3,11),.Cells(lastColTraining,11))`
End with
Fifth: If you have a Range object, you want to (most likely) Set it as a Range object. Otherwise (as per my first point) Excel will make an educated guess and in your case will return an array when you write: allDate = .Range("A2:A" & lastRow), instead use: Set allDate = .Range("A2:A" & lastRow)
Sixth: As per #SiddharthRout his comment, you'll recieve an error once your value isn't found. You can test that first trying to Set a FoundRange and check if it's not nothing.
Considering all the above, your code would run smoother using:
Option Explicit
Sub SearchDate()
Dim lastColTraining As Long, lastRow As Long, firstRowDate
Dim allTraining As Range, training As Range, allDate As Range, FoundCell As Range
Dim trainingDate As Variant
With Sheet1 'Change according to your sheets CodeName
lastColTraining = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set allTraining = .Range(.Cells(3, 11), .Cells(7, lastColTraining))
For Each training In allTraining.Columns
trainingDate = training.Rows(4)
With Worksheets("B")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set allDate = .Range("A2:A" & lastRow)
Set FoundCell = allDate.Find(What:=trainingDate, AFter:=.Range("A" & lastRow))
If Not FoundCell Is Nothing Then firstRowDate = FoundCell.Row
End With
Next training
End With
End Sub
I'm just not sure what you want with trainingDate = training.Rows(4). If you just interested in the 7th row of each column, then refer to that Range instead. Neither am I sure what your goal is with the code, but hopefully you can get it to work now.

Finding if a cell values (delimited by comma) are all existing in a defined table

Here is a sample of the report I have:
Basically the report consists in a huge list of suppliers where among other things, I need to identify which of them have all entities (content groups) for the same country, while ignoring the "integrate" tag. Entities for each country are defined in a table separately (right).
So far I tried a combination of =SUMPRODUCT(--(ISNUMBER(SEARCH())) but always getting partially what I want.
In column C, in need:
to display YES if the supplier on that row has all entities for the mentioned country code;
to display NO otherwise;
My logic on this:
The formula/s needs to pick the country code from 1st table, then look into the 2nd table where entities are defined and check if all the entities in the content group are matching, ignoring "integrate" which is a default tag applied everywhere.
Expected result:
Try:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRowA As Long, i As Long, y As Long
Dim arr As Variant
Dim CountryCode As String
Dim rng As Range, SearchRange As Range, FindPosition As Range
Dim Appears As Boolean
'Set worksheets on variables
With ThisWorkbook
Set ws1 = .Worksheets("Sheet1")
Set ws2 = .Worksheets("Sheet2")
End With
'Set the range to search in for country codes
Set SearchRange = ws2.Range("H1:R1")
With ws1
'Find the last row of Column A sheet1
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
'Start loop from row 2 to last row sheet1
For i = 2 To LastRowA
'Criteria needed ( Column A - Not empty cell, Column D - Includes "Europe" & Column E - Includes "No" Columns D and E are CASE SENSITIVE)
If .Range("A" & i).Value <> "" And .Range("D" & i).Value = "Europe" And .Range("E" & i).Value = "No" Then
CountryCode = .Range("B" & i).Value
'In which column the country code found
Set FindPosition = SearchRange.Find(What:=CountryCode, LookIn:=xlValues, LookAt:=xlWhole)
'If code excist
If Not FindPosition Is Nothing Then
'Set the range to search for the groups in the column where the code is header
Set rng = ws2.Range(ws2.Cells(2, FindPosition.Column), ws2.Cells(ws2.Cells(ws2.Rows.Count, FindPosition.Column).End(xlUp).Row, FindPosition.Column))
'Split the string with comma and assing it on arr
arr = Split(.Range("A" & i).Value)
Appears = False
'Loop the arr
For y = LBound(arr) To UBound(arr)
'Check if the arr(y) start from C as all code start from C
If Left(arr(y), 1) = "C" Then
'Count how many times the arr(y) with out the comma appears in the rng
If Application.WorksheetFunction.CountIf(rng, Replace(arr(y), ",", "")) > 0 Then
'If appears the variable Appears is true
Appears = True
Else
'If does not appear the variable Appears is False & Exit the loop
Appears = False
Exit For
End If
End If
Next y
'Check Appears variable status and import value in Column C
If Appears = True Then
.Range("C" & i).Value = "Yes"
Else
.Range("C" & i).Value = "No"
End If
'If code does not excist
Else: MsgBox "Country Code not does not excist."
End If
End If
Next i
End With
End Sub
If you have a version of Excel 2013+ which has the FILTERXML function, you can use this array formula:
=IF(OR(ISNA(MATCH(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A2,"Integrate",""),", ",","),",","</s><s>")&"</s></t>","//s"),INDIRECT("Table2["&B2&"]"),0))),"No","Yes")
We remove the Integrate
Create an XMLfrom the strings in Table1
Extract each element of the XML
Try to find them in the appropriate column of Table2
If we don't find one, then it has multiple countries.
Since this is an array formula, you need to "confirm" it by holding down ctrl + shift while hitting enter. If you do this correctly, Excel will place braces {...} around the formula as observed in the formula bar
If you have a version of Excel that does not have this function, and you are still interested in using excel formulas as opposed to VBA, there is another formula we can use.

VBA to Create Dynamic Named Ranges

I am trying to create named ranges of cells named after the top left cell in each range. This shows what I mean:
Here, I want to have 4 named ranges (Names A, Names B, Names C, Names D) so I can reference them. Is there a way to have excel look for any cell in Column B that starts with "Names" and have it cut off the range when it hits the next cell that starts with "Names"? I apologize if this is not possible, I am still new to excel and not sure if this is doable. Any help is appreciated!
This is a quick thrown together script to provide the idea of how to approach this. By no means is it pretty, but does show the steps. This can be a lot more complexly written, ie to work with all cells, not start after the first instance of names (See Range("B3") for start, and Range("B4") for starting the looping of cells)
Sub DefineRanges()
Dim rngStart As Range
Set rngStart = Range("B3")
Dim NamedRangeCount As Integer
NamedRangeCount = 0
Dim NameRangeName As String
Dim LastRow As Integer
For Each cell In Range("B4:B18")
If LCase(Left(cell.Value, 5)) = "names" Then
NameRangeName = "Name_" & NamedRangeCount
ActiveWorkbook.Names.Add Name:=NameRangeName, RefersToLocal:=Range(rngStart.Address & ":D" & cell.Row - 1)
Set rngStart = Range("B" & cell.Row)
NamedRangeCount = NamedRangeCount + 1
End If
LastRow = cell.Row
Next
NameRangeName = "Name_" & NamedRangeCount
ActiveWorkbook.Names.Add Name:=NameRangeName, RefersToLocal:=Range(rngStart.Address & ":D" & LastRow)
End Sub

Getting value of specific column for each row

I need to write script which allows me import data in xml format. It generates block of code I need for every order except variables. I need to go through all rows in range and get values from column "G". Problem is it gets only value of first row in range.
Dim rng As Range, row As Range
Set rng = Range(Range("G11"), Range("G11").End(xlDown))
For Each row In rng.Rows
Dim partner_id As String
partner_id = Cells(rng.row, 7).Value
line9 = "<typ:id>" & partner_id & "</typ:id>" & vbNewLine
...
I'm not a programmer as you can see, but I really need to get that partner_id. I would appreciate any suggestions.
You really should avoid using variable names which are the same as the common Methods used by Excel objects so, for instance, change row to be myRow perhaps. That would then highlight what I think was causing your issue - the use of rng.row which, with a renamed variable, you would probably have written as rng.myRow - which would then give a compile error.
rng.row is simply returning the row number of the first cell in rng, and has nothing to do with your variable called row.
Dim rng As Range, myRow As Range
Set rng = Range(Range("G11"), Range("G11").End(xlDown))
'There's no need to use "rng.Rows" when each row is a single cell anyway
For Each myRow In rng
Dim partner_id As String
'because myRow is a single cell, we can just use its Value
partner_id = myRow.Value
line9 = "<typ:id>" & partner_id & "</typ:id>" & vbNewLine
...
FWIW - leaving your variable names and coding style unchanged, you could have fixed the code by using row.Row instead of rng.Row, i.e.
Dim rng As Range, row As Range
Set rng = Range(Range("G11"), Range("G11").End(xlDown))
For Each row In rng.Rows
Dim partner_id As String
partner_id = Cells(row.Row, 7).Value
line9 = "<typ:id>" & partner_id & "</typ:id>" & vbNewLine
...

Resources