VBA: If Defined String EXISTS in Row, Return Value

[SteveOranjin]

Hello,

I am working on a macro that I was able to configure based off of a macro I found.

What I'd like to be able to do ideally, is to have a series of cells that I can enter values into. Say, 20. It would be a table of say, 2 columns and 20 rows on a different sheet, we'll call it sheet two.

This table will be used for me to enter a value into column 1. Say, "Dog". IN column 2 of row 1, let's say I enter "Fur"

I would then like to run a macro that will look in the column titled "Product Name" in "Sheet1" and if it spots, "Dog" it would return "Fur" in a column at the end of the data sheet in question in sheet1. So lets say there were five columns of data in sheet1. In Column 6 (it can be column 1, if that makes it easier because column 1 is always in the same spot) it would enter the value I had entered into row 1 column 2.

This is what I have done so far. I'm a shoot from the HIP VBA guy so it's the best I've done so far.

Anyone think this is very hard? If not, can I get a little help?

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub AddDashes()

Dim SrchRng As Range, cel As Range

Set SrchRng = Range("RANGE TO SEARCH")

For Each cel In SrchRng
If InStr(1, cel.Value, "TOTAL") > 0 Then
cel.Offset(1, 0).Value = "-"
End If
Next cel

End Sub</code>

 

[SteveOranjin]

File can be found here https://1drv.ms/x/s!AtYrlcV2NWPFgRJCfNg_bifel4pb

Hi Fluff,

Hope you are well. This is GREAT expect 1 thing. It doesn't return a value for a partial match. Is I were to go into the SrchRng, and I were to go to cell A3 and remove " 9TU" it would return nothing in "Pcode" since there is no exact match.

When VBA searches in column A, I'd like to see if it could provide our value in B3 if it finds a COMPLETE or a partial match. So that is to say, if it looked in DUP and found "AL6" or "AL5 AL6" or "AL5AL6AL7" it would provide the corresponding result from the search table.

Do you happen to know how to do that?

Hope you are well,

Steve

 

[Fluff]

Could you please supply some samples of what you have in both sheets?

 

[SteveOranjin]

Hey Fluff,

I have configured a sheet that expresses a lot of the patterns and even some of the inconsistencies in naming conventions that I often confront. I think we're on the same page, but I'm going to spell it out again quickly in case you require further color. You can ignore this block below if you don't think you need it.

Please see the sample data in the link below.

https://1drv.ms/x/s!AuLIQSvmFBoEhm2C1xVXcnPWVvGs

IF	The Value in C2 corresponds to a value in ROW 1 of "Sheet1"
	PERFORM NEXT TASK
	Evaluate the values in the COLUMN Header entered into C2
	If there is a MATCH between the value (Either a COMPLETE MATCH, or MATCH entered into COLUMN B and SUBSTRING) entered into B column and the column designated in the sheet, RETURN THE VALUE in COLUMN C of "SearchRng" in the "Data Sheet" tab
Other	The Value that is entered into COLUMN B should Trigger the value of COLUMN C to be entered.	Example:IF "Dog" is the designated text entered into cell b5, then search the designated column and RETURN the value entered into cell c5 in the new column.
OTHER	Cell C2 should be used to designate a column header. This is so we can CHANGE the column that values are being returned for.	Example:If I enter "ProductName" into cell C2 in "Reference Table" tab, then the discussed macro will perform the evaluation on the FIRST column named "ProductName"
Other: Column Insertion	The data sheet being entered into "Data Sheet" should be entered into an INSERTED column, or a PREDEFINED Column that is SAVED for the purpose. Whatever is easier for you.	If the data being entered into data sheet should be entered into an inserted column, that column should be inserted NEXT to the column being evaluated. So in our example, the data being entered into "Data Sheet" would be entered into the column adjacent to "ProductName", or it would be inserted IN BETWEEN columns A and Columns B.

<tbody>
</tbody>

I tried my best to make this as clear as possible.

Please let me know if i left anything hanging.

Steve

<tbody>
</tbody>

 

[Fluff]

How about

Sub AddInfo()

   Dim Cl As Range
   Dim fnd As Range
   Dim Qty As Long
   Dim i As Long
   Dim Col As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = Sheets("Data Sheet")
   Set Ws2 = Sheets("Reference Table")
   
   Set Col = Ws1.Range("1:1").find(Ws2.Range("C2").Value, Ws1.Range("XFD1"), , xlWhole, , , False, , False)
   If Col Is Nothing Then
      MsgBox "Header not found"
      Exit Sub
   End If
   Col.Offset(, 1).EntireColumn.Insert
   For Each Cl In Ws2.Range("B5", Ws2.Range("B" & Rows.Count).End(xlUp))
      Qty = Application.CountIf(Col.EntireColumn, "*" & Cl.Value & "*")
      If Qty > 0 Then
         Set fnd = Range("A1")
         For i = 1 To Qty
            Set fnd = Col.EntireColumn.find(Cl.Value, fnd, , xlPart, , , False, , False)
            fnd.Offset(, 1).Value = Cl.Offset(, 1).Value
         Next i
      End If
   Next Cl
End Sub

 

[SteveOranjin]

It wants the column to be evaluated in the first column. Column A. So if the Column to be evaluated is in column B/C/D it does not work.

         For i = 1 To Qty            Set fnd = Col.EntireColumn.Find(Cl.Value, fnd, , xlPart, , , False, , False)
            fnd.Offset(, 1).Value = Cl.Offset(, 1).Value

I think there is something wrong with that line there. It is looking to insert the data in a different column than the column that is created to receive the data.
Elsewise it is perfect.

 

[Fluff]

Change

      If Qty > 0 Then
         Set fnd = [COLOR=#ff0000]Col[/COLOR]
         For i = 1 To Qty

 

[SteveOranjin]

Change

      If Qty > 0 Then
         Set fnd = [COLOR=#ff0000]Col[/COLOR]
         For i = 1 To Qty

WOW! This is amazing!

I don't know how much you're getting paid, but I have no doubt you deserve way more. WOW!

Thank you SOOO Much! You saved the day

 

[Fluff]

Glad to help & thanks for the feedback