Macro to find if all values in an array is present in a selected cell - vba

I have a sheet named Assignee which contains the names of certain persons. I have another sheet named Raw which contains multiple rows containing text strings. My requirement is to find out if any of the names in sheet Assignee is present in a cell, and if so, which is the last name in that cell. To specify more, see following example,
Assignee sheet contains names Vivek S. Panicker in cell A1, John Smith in A2 and William Dezuza Margeret in A3. Raw sheet A1 cell contains a text string like, "John Smith met me last night to inquire about William Dezuza Margeret". The last name in this string is "William Dezuza Margeret", which I need to extract using a VBA code. Since this need to be done in multiple lines, a macro with loop is highly appreciated.

Function LastUsedName(rng As Range) As Variant
Dim names As Variant
names = Sheets("Assignee").Range("A1:A" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row)
Dim v As Variant
For Each v In names
If InStr(1, rng, v, vbTextCompare) Then
Dim pos As Long
pos = InStrRev(rng, v, -1, vbTextCompare)
LastUsedName = Mid(rng, pos, Len(v))
Exit Function
End If
Next
End Function

Related

Excel VBA extract substring based on InStr and paste into worksheet2 loop for all cells in column

Microsoft Excel VBA
I have a list of strings containing shop ID codes & address combined in column Y, and I want to go down this list, extract just the ID code, and paste this into a second spreadsheet in column C.
I am struggling with how to use a For statement to loop this for each cell in the columns, as I want the statement to find the info from a cell in Activesheet column Y, then paste the substring into Sheet Part 1 Column C, and then loop to the next cell in the range for both sheets.
My insufficient code:
set up a for loop for the Y column in ActiveSheet, where the shop ID info is stored
For Each cell In ActiveSheet.Range("Y:Y")
create a location variable to store the instr value, should change each loop, not sure if this is the way to do it however
Dim location As Integer
create an object that stores where the ID code finishes in my string
location = InStr(1, ActiveSheets.Range("Y:Y"), " ")-1
using the left function with the location object, tell excel I want to copy the shop ID and paste it into column C in the Part 1 Sheet.
Left(xCell, location).Copy Sheets("Part 1").Range("C:C")
Next
Full Code without annotations:
For Each cell In ActiveSheet.Range("Y:Y")
Dim location As Integer
location = InStr(1, ActiveSheets.Range("Y:Y"), " ")-1
Left(xCell, location).Copy Sheets("Part 1").Range("C:C")
Next
Thanks for any advice
Dim Location as long
Dim c as range
For each c in range("Y:Y")
Location = instr(" ",trim(c.text))
if location >0 then
sheets("Part 1").range("C" & c.row).value = left(c,location)
end if
next c
This assumes that you want them to appear in column C in the same row as they are in in column Y
Edit to fix my error and to add a trim - I suspect you have a leading space in column Y?

Using loop and sum functions with Vlookup

I've got a macro that essentially searches column C in Sheet1 for the value "Rec" and copies the corresponding value in column D, then pastes it into the last open cell in column B of Sheet2. It does just what it is supposed to do and is as follows:
Sub FindPasteGSVInNextCell()
Worksheets("Sheet2").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
WorksheetFunction.VLookup("Rec", Sheet1.Range("C2:H25"), 2, False)
End Sub
I now want the code, instead of just searching for a single "Rec" value, to search for all rows with "Rec" in column C and to sum up all of their corresponding values in column D, then place that sum into Sheet2.
I am assuming that I need some kind of Do Until loop or something, but I am not exactly sure how to format it... I am a beginner with VBA, so any help would be greatly appreciated.
vlookup will not work as it will continue to only grab the first instance of "Rec".
On Sheet 2 list all the possible categories in column A then in column B1 put
= sumif(Sheet1!C:C,A1,Sheet1!D:D)
then copy down. This will Get you the totals by category.
If you want to use VBA, you will still need a list of categories setup somewhere, either hard coded or listed somewhere that you can loop through.
If your list was in column A on Sheet2 then you would:
dim ws as worksheet
set ws = Worksheets("Sheet2")
For each i in ws.range(ws.Range("A1"),ws.Range("A1").offset(xldown)).Cells
i.offset(,1) = WorksheetFunction.Sumif(Worksheets("Sheets1").Range("C:C"), _
i,Worksheets("Sheets1").Range("D:D"))
next i

Excel VBA - Column count using variants

I have searched the forums but I am really struggling to get part of my code to work. Basically the idea is to search sheet 1 and copy one or more columns depending on the criteria to a specific worksheet.
i.e. if sheet 1 columns 1 and 3 contain "copy 01" then copy both columns to a sheet 2 and if sheet 1 columns 2 and 4 contain "copy 02" then copy both columns to a sheet 3 etc.
I can count rows fine using the code, but can't count columns. Seems to relate to not fiding the column range but I have no ideas to fix this! Any help would be much appreciated.
'Row
Dim NR As Long
Dim d As Variant
d = ws1.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For NR = 1 To UBound(d, 1)
'column
Dim NC As Long
Dim e As Variant
e = ws1.Range(Cells(1, Columns.Count).End(xlToLeft).Column).Value
For NC = 1 To UBound(e, 1)
Thanks,
Stewart
You want this:
e = range("A1:" & split(cells(1,cells(1,columns.Count).end(xlToLeft).column).address(true,false), "$")(0) & "1").Address
The cells(1, columns.count).end(xlToLeft).column) gets the last column number (for example 13 for 'M').
Putting this into cells(1, lastcolNum) gets a cell that represents the cell in the first row of this column (for example Cell M1).
The address(true, false) method gets the cell reference with a dollar sign before the row but not before the column letter (for example "M$1"
The split function returns an array which splits the input string by the "$" character (for example array - ("M","1")
The (0) returns the 0th element in the returned array (for example "M")
Then putting this into the range function returns the range (for example) "A1:M1"
I'm not entirely sure what you're trying to do with the UBound function here. It would make more sense to make
e = cells(1,columns.count).end(xlToLeft).column
and then loop through
For N = 1 To e
As this will loop through each column.

Excel Find & Replace Macro

I have a worksheet which imports all of my orders, however when creating labels, I only have a limited amount of space for the title. I'm using a Find & Replace Macro in Excel which looks in my current active imported worksheet, and replaces with text from another worksheet which I use as a table with 2 columns, Column A is what the title is when imported and Column B is what I want to change it to. This script works perfectly fine except it doesn't find columns that have a different beginning. For example:
Imported Worksheet:
Entry 1: BANANAS
Entry 2: 30 X BANANAS
Table:
Column A: BANANAS
Column B: Yellow Bananas
//Script Runs//
Output:
Imported Worksheet:
Entry 1: Yellow Bananas
Entry 2: 30 X BANANAS
As you can see in the example above, the "30 X BANANAS" entry does not change to "30 X Yellow Bananas", as I would want it to. I'm guessing I need to add a wildcard line of code to my script below, but I'm not sure how to incorporate it?
Sub FindReplace()
Dim s As String
Dim cell As Range
For Each cell In Range("H3:H5000").Cells
If cell <> "" Then
ans = Application.VLookup(cell, Sheets("Script").Range("A1:B1000"), 2, 0)
If Not IsError(ans) Then cell = ans
End If
Next cell
End Sub
If you use the Range.Replace function rather than the VLookup function, you will get the result you are looking for.
Before
After
Sub FindNReplace()
Dim InputRng As Range, ReplaceRng As Range
'Set Range Values
Set InputRng = Range("A1:A5")
Set ReplaceRng = Sheets("Script").Range("A1:B100")
'Spin through replacement range and perform replace
For Each Rng In ReplaceRng.Columns(1).Cells
InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
End Sub

Excel Range Reference

Let me preface this question by saying I am not super technical so much of my verbiage may seem obscure..
On sheet1 I have three seperate horizontal ranges of cells (3 seperate series of steps):
A1:D1
A2:C2
A3:E3
On sheet two, I'd like to link to create live links to these ranges, such that if I change information on sheet1, it will be automatically reflected in sheet2.
The catch is, that on sheet2, I want the ranges to be listed after one another in one row, to create one long series of steps.
Range1-->Range2-->Range3 (all on one row)
How do I ensure that if I add an additional step to, say, the first range on sheet1, that on sheet 2, the new cell will be added and the following cells will all be pushed over to the right by one cell?
To accommodate ranges that might grow, start from the first cell and then find the last occupied cell with End(xlToRight). Once you've found all the range extents, you can combine them with an array UDF:
Function ConcatRanges(ParamArray ranges()) As Variant()
Application.Volatile
Dim ret() As Variant
ReDim ret(1 To 1, 1 To (Application.Caller.Columns.Count))
Dim RetIdx&, i&, cell As Range
RetIdx = 1
For i = 0 To UBound(ranges)
For Each cell in Application.Range(ranges(i), ranges(i).End(xlToRight))
ret(1, RetIdx) = cell.Value
RetIdx = RetIdx + 1
Next
Next
For RetIdx = RetIdx To UBound(ret, 2)
ret(1, RetIdx) = vbNullString
Next
ConcatRanges = ret
End Function
For your example, you'd call it like this:
=ConcatRanges(Sheet1!A1, Sheet1!A2, Sheet1!A3)