Macro to Search for Value in One Column and Append the value in another column

K

KlayontKress

Board Regular
Joined
Jan 20, 2016
Messages
67
Office Version
  1. 2016
Platform
  1. Windows
I'm looking for a macro to look for a specific Text String in a column and then append the value in another column. We have a program that exports out to a template in excel to do generate a pricing quote for our customers and We have someone manually doing adding values to the name of the product to reflect it's modifications.

For example, the column I want to search is Column E and the value I want to Append is Column A. I need a macro to search Column E for "ID=15" and then add ID15 to the end of the value in column A. I need the macro to search the entire column of E and do the Modifications as there isn't a set length to the data though it rarely goes past 30 line items.

A picture of the sheet is below. I need to be able to do this with several different values but a basic Macro to do the above will allow me to adapt it to my needs.




[TABLE="width: 522"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]Description[/TD]
[TD]Customer Description[/TD]
[TD]Qty[/TD]
[TD]Options[/TD]
[TD]Modifications[/TD]
[/TR]
[TR]
[TD]ACM8[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B33 SS1 BUTT[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B39 SS1[/TD]
[TD][/TD]
[TD]2.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]BTK8 PRT[/TD]
[TD][/TD]
[TD]2.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CM8 BLD[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CM8 WD[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SHM8 BLD[/TD]
[TD][/TD]
[TD]2.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UF2[/TD]
[TD][/TD]
[TD]2.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UF3[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UF342[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UM8 BLD[/TD]
[TD][/TD]
[TD]3.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]UM8 WD[/TD]
[TD][/TD]
[TD]3.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]W3036 BUTT[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD]FEDEP;UPBOX[/TD]
[TD]IND12~ID=15[/TD]
[/TR]
[TR]
[TD]W3342 BUTT[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]W3624 BUTT[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]W3942[/TD]
[TD][/TD]
[TD]2.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]W3036 BUTT[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD]IND12~ID=15[/TD]
[/TR]
[TR]
[TD]SM8 WD[/TD]
[TD][/TD]
[TD]1.00 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col></colgroup>[/TABLE]



Thanks in advance,
 
Sort by date Sort by votes

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
For those that may need something similar, here is the code which I am running.

Code: 
Sub AppendString()
'======================================
'ID Search
'======================================
lRow = ActiveSheet.Cells(Rows.Count, [B]5[/B]).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, [B]5[/B]) Like "*" & "ID=4" & "*" Then
            Cells(i, [B]1[/B]) = Cells(i, [B]1[/B]) & ", ID 4"
        End If
Next
'
'The above code is one complete search screening. I repeated it for all the variations I needed. If you need to adapt it for different columns, change the bolded numbers to the column number you need. In this case, 5 = column E and 1=Column A
'
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=5" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 5"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=6" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 6"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=7" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 7"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=8" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 8"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=9" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 9"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=10" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 10"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=11" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 11"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=12" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 12"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=13" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 13"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=14" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 14"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=15" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 15"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=16" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 16"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=17" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 17"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=18" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 18"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=19" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 19"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=20" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 20"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=21" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 21"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=22" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 22"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=23" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 23"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "ID=24" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", ID 24"
        End If
Next
'======================================
'RD Search
'======================================
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=4" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 4"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=5" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 5"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=6" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 6"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=7" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 7"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=8" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 8"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=9" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 9"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=10" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 10"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=11" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 11"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=12" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 12"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=13" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 13"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=14" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 14"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=15" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 15"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=16" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 16"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=17" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 17"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=18" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 18"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=19" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 19"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=20" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 20"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=21" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 21"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=22" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 22"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=23" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 23"
        End If
Next
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "RD=24" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", RD 24"
        End If
Next
'======================================
'MI Search
'======================================
lRow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 4) Like "*" & "MI" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", MI"
        End If
Next
'======================================
'FEDEP Search
'======================================
lRow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 4) Like "*" & "FEDEP" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", FE"
        End If
Next
'======================================
'OFD Search
'======================================
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "VD=OFD" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", OFD"
        End If
Next
'======================================
'MFD Search
'======================================
lRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To lRow
        If Cells(i, 5) Like "*" & "VD=MFD" & "*" Then
            Cells(i, 1) = Cells(i, 1) & ", MFD"
        End If
Next
End Sub
 
Upvote 0
KlayontKress said:
Works like a charm. Thank you for helping with this.
Click to expand...

Well it took a little back and forth but I am glad you got it working the way you wanted. I was happy to help.

Thanks for the feedback!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Multiple columns to populate data on userform based on header in combobox
Replies
4
Views
97
abdo meghari
A
A
  • Question Question
Copy a cell from one workbook to another if value searched found
Replies
0
Views
737
AS1
A
J
  • Solved
VBA loop to search every cell value from one column in another one and transpose the data from that row
Replies
3
Views
786
offthelip
O
Woozypictures
  • Solved
VBA Code to copy specific rows from one sheet to another, based on cell value
Replies
6
Views
3K
Woozypictures
Woozypictures
P
  • Question Question
Macro for updating one excel workbook based on column values from another excel workbook
Replies
0
Views
1K
Pritisingh689
P

Forum statistics

Threads
1,223,896
Messages
6,175,265
Members
452,627
Latest member
KitkatToby

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top