Finding a cell then copying data 2 cells right

[chipchuck]

Hello all, thanks in advance for the help as I am baffled.

This is what I need a macro to do:

Begin at cell B1
Look at the cell and if the cell value is "PROVIDER" jump over 2 cells to the right, copy that data, and paste it in Column A of another Worksheet. Then go back to Column B and continue down the list until it reaches the end of the data (note there are no spaces until the end so I'm trying to do it with a Do While Not IsEmpty(ActiveCell) code.)

Thanks again
Chip

[Ken Puls]

Hi there,

This will copy from all cells in column B, and if the cell value matches "PROVIDER" exactly (all caps), it will copy it to the next available cell in column A on Sheet2:


Sub CopyIt()
Dim cl As Range
With Worksheets("Sheet1")
For Each cl In .Range("B1:B" & .Range("B65536").End(xlUp).Row)
If cl.Value = "PROVIDER" Then
cl.Copy Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End with
End Sub

For reference, this: "B1:B" & .Range("B65536").End(xlUp).Row could easily be "B1:B25"

Let me know if you need any modifications.

[chipchuck]

Thanks for the help, but I'm looking more for code that will move the ActiveCell around.


When the code sees PROVIDER in column B it should copy the cell in D of that row and paste it in the other sheet.

[Aaron Blood]

If you're wiling to use my Find_Range function, you can do it in a single action.



Sub Ex_12()
x = "PROVIDER"
Set Found_Range = Find_Range(x, Sheet1.Columns("B"), xlValues, xlPart).Offset(0, 2)
Found_Range.Copy Range("Sheet2!A1")
End Sub


The code for the Find_Range function is available on my website.
http://www.xl-logic.com/xl_files/vba/kickbutt_find_function.zip

[Ken Puls]

Sorry, Chipchuck, I missed the column D.

For reference, the below code is adjusted to account for that.


Sub CopyIt()
Dim cl As Range
With Worksheets("Sheet1")
For Each cl In .Range("B1:B" & .Range("B65536").End(xlUp).Row)
If cl.Value = "PROVIDER" Then
cl.offset(0,2).Copy Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End with
End Sub

FYI, this will accomplish what you want without moving the activecell. We could modify it to use the activecell, but it is unnecessary to do so. Basically what this does is look at B1 and if it equals "PROVIDER" it will copy D1 to the next available cell on Sheet2 column A. Then it goes back to B2 and continues on.

I haven't tried Aaron's (Open Source! :rotlaugh: ) solution, but am sure it will work also.

[Aaron Blood]

I haven't tried Aaron's (Open Source! :rotlaugh: ) solution, but am sure it will work also.
Alright... what's so funny about the open source comment?

[Ken Puls]

It's just the "new wave" kind of thing. Everything is going "open source" these days. I've just never seen anyone refer to their VBA stuff that way yet.

I'm not questioning the accuracy of the statement at all, it's just that most VBA'ers that I've met so far still say that it "isn't password protected" or something. :yes

[Aaron Blood]

It's just the "new wave" kind of thing. Everything is going "open source" these days. I've just never seen anyone refer to their VBA stuff that way yet.

I'm not questioning the accuracy of the statement at all, it's just that most VBA'ers that I've met so far still say that it "isn't password protected" or something. :yes
OIC, I'm not really in the programming world. Wasn't aware of the possible cheesiness factor... I'll avoid saying it in the future then.

[Ken Puls]

Aaron, that wasn't at all what I was getting at. It's less words... use it!

[Zack Barresse]

ROFLMAO!!! :rotlaugh:

You two are hilarious!

Cheesiness factor .. .. .. 10!!! LOL! :*)