Macro that concatenates content from cells if given keyword is found

[andrei]

Hello guys !

Here is what i want from a macro

In cells from B column i have from time to time a keyword . The macr
should find that keyword , to concatenate text from that cell with th
text from coresponding cell in C column and put the result in D colum
beginning with the first cell . Here is an example :

Keyword = "mother"

B1 = mother C1 = and
B4 = daddy C4 = uncle
B6 = mother C6 = goes
B8 = mother C8 = is
B10 = sister C10= and
B20 = mother C20 = was


The result should be :

D1 = mother and
D2 = Mother goes
D3 = mother is
D4 = mother was

If this macro could work in all sheets , that would be magnific !
Many thanks in advance

PS: Sorry for my bad english

 

[Matthew Herbert]

Andrei,

Use a simple IF function in your spreadsheet. So, let's say that cell A1
contains your keyword "mother". In cell D1, put the following formula:

=IF(B1=$A$1,B1&" "&C1,"")

You can then copy the formula down and you should see your desired results.

Best,

Matthew Herbert

 

[andrei]

Thanks , i use a function like that but it really kills me because my
sheets have 8000-10000 rows and my workbooks have 60-80 sheets . That's
why i'm searching for a macro

 

[Simon Lloyd]

This will do what you need

Sub fnd(
Dim rngFind As Rang
Dim strValueToPick As Strin
Dim rngPicked As Rang
Dim rngLook As Rang
Dim strFirstAddress As Strin
Dim oCell As Rang
Dim Sh As Workshee
Application.ScreenUpdating = Fals
strValueToPick = InputBox("Enter value to find", "Find al
occurences"
For Each Sh In Sheet
Set rngLook = Sheets(Sh.Name).Range("B1:B"
Sheets(Sh.Name).Range("B" & Rows.Count).End(xlUp).Row

With rngLoo
Set rngFind = .Find(strValueToPick, LookIn:=xlValues
lookat:=xlWhole
If Not rngFind Is Nothing The
strFirstAddress = rngFind.Addres
Set rngPicked = rngFin
D
Set rngPicked = Union(rngPicked, rngFind
Set rngFind = .FindNext(rngFind
UserForm1.ListBox1.AddItem rngFind.Addres
Loop While Not rngFind Is Nothing And rngFind.Address <
strFirstAddres
End I
End Wit

If Not rngPicked Is Nothing The
For Each oCell In rngPicke
oCell.Offset(0, 2).Value = oCell.Value & " " & oCell.Offset(0
1).Valu
Next oCel
End I
Next S
Application.ScreenUpdating = Tru
End Su

Thanks , i use a function like that but it really kills me because m
sheets have 8000-10000 rows and my workbooks have 60-80 sheets . That'
why i'm searching for a macr

--
Simon Lloy

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com

 

[andrei]

It gives me in error here :

USERFORM1.LISTBOX1.ADDITEM RNGFIND.ADDRESS

If i delete this from the macro , it works , but puts the result in D
column not the way i want , as i said in first post

 

[Simon Lloyd]

Try this:Sub fnd()
Dim rngFind As Range
Dim strValueToPick As String
Dim rngPicked As Range
Dim rngLook As Range
Dim strFirstAddress As String
Dim oCell As Range
Dim Sh As Worksheet
Application.ScreenUpdating = False
strValueToPick = InputBox("Enter value to find", "Find all
occurences")
For Each Sh In Sheets
Set rngLook = Sheets(Sh.Name).Range("B1:B" &
Sheets(Sh.Name).Range("B" & Rows.Count).End(xlUp).Row)

With rngLook
Set rngFind = .Find(strValueToPick, LookIn:=xlValues,
lookat:=xlWhole)
If Not rngFind Is Nothing Then
strFirstAddress = rngFind.Address
Set rngPicked = rngFind
Do
Set rngPicked = Union(rngPicked, rngFind)
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address
<> strFirstAddress
End If
End With

If Not rngPicked Is Nothing Then
For Each oCell In rngPicked
oCell.Offset(0, 2).Value = oCell.Value & " " &
oCell.Offset(0, 1).Value
Next oCell
End If
Sh.Range("D1" & Sh.Range("D" &
Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete
shift:=xlUp
Next Sh
Application.ScreenUpdating = True
End Sub


--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)

 

[andrei]

Many thanks , it works

 

[Simon Lloyd]

Glad we could be of help

--
Simon Lloy

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com