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

Rahulkr

Board Regular
Joined
Dec 10, 2019
Messages
66
Office Version
  1. 2010
Platform
  1. Windows
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.
ColumnABCDEFG
Row 1DaysD1D2D3D4D5D6
Row 2typePH1PH2PH3PH4PH5PH6
Row 3jk
Row 4lm
Row 5
Row 6no
Row 7
Row 808:30 Ande
Row 9
Row 10789pq
Row 1189yy

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:-

1612808125545.png


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.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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?
 
Upvote 0
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.
 
Upvote 0
Try this code:
VBA 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
 
Upvote 0
Try this code:
VBA 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?
 
Upvote 0
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)?
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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:
VBA Code:
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
 
Upvote 0
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.

 
Upvote 0

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

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