Using an "If" statement to move data from one column to another

[Jbm]

Hi,
Tried looking this one up in the archives, and while I'm sure it's there I
couldn't find it.
I have data in column B, around 5000 rows. I'm wondering how to move any
cells from column B to column G if and only if they contain certain words.
Additionally, I'd like for the values copied into G to be put in rows 1, 2,
3, 4 etc. instead of the rows they're in now. An example here might help --
I have something like:

Column B
Hardwood Floors
Carpeted Floors
Laminate Floors
Oak Wood Floors
Tile Floors
Beechwood Floors

Supposing I wanted to pull out any cells with the word "wood" in them, I
would want column G to look like this:

Column G
Hardwood Floors
Oak Wood Floors
Beechwood Floors

in consecutive rows starting from the top. Essentially, the more automated
this process is the better, since I have a new sheet with similar data every
week for that week. Any help would be appreciated, thanks.

 

[Jbm]

I realized an oversight in my question (is there no edit function on posts?):
I also have numerical data in Column C that I'd like to move with its
corresponding value in Column B. So with the previous example, if the number
26 occupied cell C4 corresponding to Oak Wood Floors, I'd like cell H2 to
then show 26 when Oak Wood Floors moved. Also I'm running Excel 2007. Sorry
for the length of this question and my forgetfulness, but thanks for any help!

 

[Luke M]

I would suggest using this macro. Press Alt+F11 to open VBE, then Alt+I, M.
(you should now have a blank module. Paste this coding in:

'==========
Sub DataMove()
KeyWord = InputBox("What word do you want to look for?", "Key Word")
If KeyWord = "" Then Exit Sub
RowCount = 1
For Each c In Range("B:B")
If c.Value Like "*" & KeyWord & "*" Then
Cells(RowCount, "G").Value = c.Value
RowCount = RowCount + 1
End If
Next
End Sub
'===========


Back in your workbook, you can play the macro (Alt+F8). You'll be prompted
for the word you want, and it will then move over your data from B to G,
starting in row 1.

 

[Luke M]

Modified coding (and I agree, a edit function would be most helpful!):

'==========
Sub DataMove()
KeyWord = InputBox("What word do you want to look for?", "Key Word")
If KeyWord = "" Then Exit Sub
RowCount = 1
For Each c In Range("B:B")
If c.Value Like "*" & KeyWord & "*" Then
'Copies value with Key Word in it
Cells(RowCount, "G").Value = c.Value
'Copies corresponding value
Cells(RowCount, "H").Value = c.Offset(0,1).Value
RowCount = RowCount + 1
End If
Next
End Sub
'===========

 

[Jbm]

Luke,
Thanks for the quick response and good macro. There are three things
however that I would like to modify if I can. First, is there a way to have
the macro look for the word itself, instead of requiring input from me after
the macro is run? So perhaps the word "wood" would be needed somewhere in
the text of the macro itself? Second, can I do multiple words at once, like
"wood" and "tile"? Finally, and it seems this is entirely my fault since you
responded so quickly you didn't see my "edit," is there a way for the macro
to copy the corresponding data in the column next to B? You've already been
a great help, these changes would just refine the operation to automate this
process as much as possible. Thanks again.

 

[Jbm]

I didn't want you to waste time if you look at this later, so here's an
update. I played around with the code for a while (I'm new at macros and
learning as I go) and came up with almost what I want to do. The only thing
I haven't figured out is how to get the macro to do the operation for several
terms. I have "If c.Value Like "Wood" Then" and I need to do it for Wood and
Tile. Whether you can help me with that or not, I really do appreciate all
the help to this point, without your suggested macro I'd be nowhere on this,
but because of it I've figured out a workable (if messy) macro for my problem.

 

[Luke M]

You can add multiple criteria using Or(s).

If c.value like "*wood*" Or _
c.value like "*tile*" Or _
c.value like "*ceramic*" Then
'rest of coding...


Note the use of asterisks as wildcards to search for your word(s).

 

[Jbm]

Luke,
That is quite simply perfect. For reference, the final macro I used looked
something like this:

Sub DataMove()
RowCount = 2
For Each c In Range("B:B")
If c.Value Like "*wood*" Or _
c.Value Like "*tile*" Or _
c.Value Like "*soft*" Or _
c.Value Like "*hard*" Or _
c.Value Like "*light*" Or _
c.Value Like "*dark*" Or _
c.Value Like "*medium*" Then
Cells(RowCount, "H").Value = c.Value
Cells(RowCount, "I").Value = c.Offset(0, 1).Value
Cells(RowCount, "J").Value = c.Offset(0, 2).Value
Cells(RowCount, "K").Value = c.Offset(0, 3).Value
Cells(RowCount, "G").Value = c.Offset(0, -1).Value
RowCount = RowCount + 1
End If
Next
End Sub

Not only did you answer my question, but I learned a great deal about
writing macros this morning. Really, thank you very much, the help is
endlessly appreciated.

 

[Luke M]

Glad to help, and thanks for the feedback!

 

[tmb555555]

Hello,
I stumbled upon this string and thought it would be useful to help m
solve a similar problem. I modified the code to the below which work
great. The only problem I have is that instead of copying the data t
column G, I would like to move the data over one row and up one colum
and then delete the column that it came from. Is this possible?

Sub DataMove()
KeyWord = InputBox("What are you looking for?", "Key Word")
If KeyWord = "" Then Exit Sub
RowCount = 1
For Each c In Range("A:A")
If c.Value Like "*" & KeyWord & "*" Then
'Copies value with Key Word in it
Cells(RowCount, "G").Value = c.Value
RowCount = RowCount + 1
End If
Next
End Su

 

[Rick Rothstein]

Your "over one row, up one column" statement is a little confusing (usually
you go up rows and over columns), so I'm not totally sure where the data is
to go. I have assumed you meant if the keyword was found in, say, A3, then
you want the it moved to B4. This movement is controlled by the values in
the Offset property call (first argument is row offset, second argument is
column offset, both values can be plus or minus as needed). I also wasn't
sure if you really meant that you wanted to delete the entire column (as
your description seems to say) or just the value in the original cell (as I
think you meant)... I assumed the latter which is what the C.Clear statement
does.

Sub DataMove()
KeyWord = InputBox("What are you looking for?", "Key Word")
If KeyWord = "" Then Exit Sub
RowCount = 1
For Each C In Range("A:A")
If C.Value Like "*" & KeyWord & "*" Then
'Copies value with Key Word in it
C.Offset(1, 1).Value = C.Value
RowCount = RowCount + 1
C.Clear
End If
Next
End Sub

 

[tmb555555]

have attached a sample workbook. What I am trying to do is move ever
cell that contains "d/b/a" (as in A26). I would like to move the data i
these cells to the right one column and then up one row (in thi
instance to B25). Then I would like for it to delete the row that i
came from (in this instance 26) so that the contact data is in 5 ro
blocks with no blank rows while still keeping the "d/b/a" data. If
could do this with a macro it would save me an enormous amount of tim
over doing it manually.......

Your "over one row, up one column" statement is a little confusin
(usually
you go up rows and over columns), so I'm not totally sure where th
data is
to go. I have assumed you meant if the keyword was found in, say, A3
then
you want the it moved to B4. This movement is controlled by the value
in
the Offset property call (first argument is row offset, second argumen
is
column offset, both values can be plus or minus as needed). I als
wasn't
sure if you really meant that you wanted to delete the entire colum
(as
your description seems to say) or just the value in the original cel
(as I
think you meant)... I assumed the latter which is what the C.Clea
statement
does.

Sub DataMove()
KeyWord = InputBox("What are you looking for?", "Key Word")
If KeyWord = "" Then Exit Sub
RowCount = 1
For Each C In Range("A:A")
If C.Value Like "*" & KeyWord & "*" Then
'Copies value with Key Word in it
C.Offset(1, 1).Value = C.Value
RowCount = RowCount + 1
C.Clear
End If
Next
End Sub

--
Rick (MVP - Excel)



The Code Cage Forums
(http://www.thecodecage.com/forumz/showthread.php?t=119849)

+-------------------------------------------------------------------
|Filename: Book1.xls
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=278
+-------------------------------------------------------------------

 

[Simon Lloyd]

All, the poster posted incorrectly but it has now (after a bit of Q&A
been sorted with thi

Code
-------------------
Sub DataMove(
Dim c As Rang
KeyWord = InputBox("What word do you want to look for?", "Key Word"
Application.ScreenUpdating = Fals
If KeyWord = "" Then Exit Su
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row
If c.Value Like "*" & KeyWord & "*" The
c.Offset(-1, 1).Value = c.Valu
c.EntireRow.Delet
End I
Next
Application.ScreenUpdating = Tru
End Su
-------------------

Your "over one row, up one column" statement is a little confusin
(usuall
you go up rows and over columns), so I'm not totally sure where th
data i
to go. I have assumed you meant if the keyword was found in, say, A3
the
you want the it moved to B4. This movement is controlled by the value
i
the Offset property call (first argument is row offset, second argumen
i
column offset, both values can be plus or minus as needed). I als
wasn'
sure if you really meant that you wanted to delete the entire colum
(a
your description seems to say) or just the value in the original cel
(as
think you meant)... I assumed the latter which is what the C.Clea
statemen
does

Sub DataMove(
KeyWord = InputBox("What are you looking for?", "Key Word"
If KeyWord = "" Then Exit Su
RowCount =
For Each C In Range("A:A"
If C.Value Like "*" & KeyWord & "*" The
'Copies value with Key Word in i
C.Offset(1, 1).Value = C.Valu
RowCount = RowCount +
C.Clea
End I
Nex
End Su

-
Rick (MVP - Excel




The Code Cage Forums
(http://www.thecodecage.com/forumz/showthread.php?t=119849

--
Simon Lloy

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

 

[Rick Rothstein]

Thank you for letting us know the issue has been resolved.