Formula or vba code to copy entire column based on text found in entire cell range

[Rahulkr]

Dear All masters, I am having some data like below:- Is there any formula or Vba code to fetch or copy entire column based on text found. Many many thanks in advance.

Column	A	B	C	D	E	F	G
Row 1	Days	D1	D2	D3	D4	D5	D6
Row 2	type	PH1	PH2	PH3	PH4	PH5	PH6
Row 3					jk
Row 4					lm
Row 5
Row 6					no
Row 7
Row 8					08:30 Ande
Row 9
Row 10					789pq
Row 11					89yy

From this data I need to copy only that entire column in which the word "ANDE" is found and paste the entire row as below in another sheet:-

It it fixed that the word which I have to search will be unique, but it is not fixed that the word which I will search will be in same column, every time it will be changing the position from cell to cell and column to column.
But the given range of data will be fixed.

Many many thanks in advance. if any one can help on this.

 

[Joe4]

From this data I need to copy only that entire column in which the word "ANDE" is found and paste the entire row as below in another sheet:-

Paste the entire row or the entire column?

What is the name of the sheet this data is on?
What is the name of the sheet you want it pasted to?
Where exactly on the other sheet will this be pasted?

 

[Rahulkr]

Paste the entire row or the entire column?

What is the name of the sheet this data is on?
What is the name of the sheet you want it pasted to?
Where exactly on the other sheet will this be pasted?

Thanks Joe for the response.
Now as per your question.
1 Paste Entire Column

2. The name of the sheet this data is on "Sheet1"

3. The name of the sheet I want it to be pasted on "Sheet2"

4. it should be pasted anywhere it doesn't matter.

 

[Joe4]

Try this code:

Sub MyMacro()

    Dim myText As String
    Dim c As Long

'   Prompt to string to look for
    myText = InputBox("What string would you like to find?")
    
'   Locate value on sheet 1
    On Error GoTo err_chk
    Sheets("Sheet1").Select
    c = Cells.Find(What:=myText, After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    On Error GoTo 0
        
'   Copy and paste to sheet 2
    Columns(c).Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste

    MsgBox "Macro complete!"

    Exit Sub
    
err_chk:
'   error handling if cannot find value
    If Err.Number = 91 Then
        MsgBox "Cannot find " & myText & " on Sheet1", vbOKOnly, "ERROR!"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
        
End Sub

 

[Rahulkr]

Try this code:

Sub MyMacro()

    Dim myText As String
    Dim c As Long

'   Prompt to string to look for
    myText = InputBox("What string would you like to find?")
   
'   Locate value on sheet 1
    On Error GoTo err_chk
    Sheets("Sheet1").Select
    c = Cells.Find(What:=myText, After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    On Error GoTo 0
       
'   Copy and paste to sheet 2
    Columns(c).Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste

    MsgBox "Macro complete!"

    Exit Sub
   
err_chk:
'   error handling if cannot find value
    If Err.Number = 91 Then
        MsgBox "Cannot find " & myText & " on Sheet1", vbOKOnly, "ERROR!"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
       
End Sub

Dear Joe Thanks a lot for your effort, but it is throwing error as "Subscript out of range". and instead of running macro manually can it be done automatically if the data changes in Sheet 1?

 

[Joe4]

Dear Joe Thanks a lot for your effort, but it is throwing error as "Subscript out of range". and instead of running macro manually can it be done automatically if the data changes in Sheet 1?

Did you place this directly in the Sheet1 module, or a General module (I wrote it for a General module)?

How exactly is the data being changed on Sheet1?
What kind of data change are you looking for (certain range, values, etc)?

 

[Rahulkr]

Did you place this directly in the Sheet1 module, or a General module (I wrote it for a General module)?

How exactly is the data being changed on Sheet1?
What kind of data change are you looking for (certain range, values, etc)?

Dear Joe, I tried in both, but it is showing the same error. In sheet 1, manually user will change the data as per the requirement and the data can be looked up in certain range only

 

[Joe4]

So, if you want it to happen automatically, then you probably do not want the prompt for the value you are looking for, but rather hard-code it in there.

Also note that if he have it run automatically upon when they update data, every time the change a cell, it will run, and overwrite the previous values in Sheet2.
I just want to confirm that this is what you really want to happen.

 

[Joe4]

If all those things are correct, then paste this code in the "Sheet1" module, and it will run upon any manual data change to Sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myText As String
    Dim c As Long

'   Enter value to look for
    'myText = InputBox("What string would you like to find?")
    myText = "Ande"
    
'   Locate value on sheet 1
    On Error GoTo err_chk
    c = Cells.Find(What:=myText, After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    On Error GoTo 0
        
'   Copy and paste to sheet 2
    Columns(c).Copy Sheets("Sheet2").Range("A1")

    Exit Sub
    
err_chk:
'   error handling if cannot find value
    If Err.Number = 91 Then
        MsgBox "Cannot find " & myText & " on Sheet1", vbOKOnly, "ERROR!"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
        
End Sub

 

[Rahulkr]

So, if you want it to happen automatically, then you probably do not want the prompt for the value you are looking for, but rather hard-code it in there.

Also note that if he have it run automatically upon when they update data, every time the change a cell, it will run, and overwrite the previous values in Sheet2.
I just want to confirm that this is what you really want to happen.

Exactly Joe, this is what I want, no matters if it overrides also. for better understanding please find the link to download my excel file in which I am working right now. So that you can better understand what I am looking for.

demo.xlsm

drive.google.com