Find word in a column then copy range starting with that word

[Cr864]

Hi everyone,

How in excel with VBA could I look in a specific column for a word (this word will only ever appear once) and then copy from that word down to the last row of that column? The row the word could be in will be random unfortunately so I have to find it as my starting point somehow.



Thank you for any help!

 

[gordsky]

where are you going to paste what you have copied?

 

[gordsky]

Sub FindWrd()

    Dim ws As Worksheet
    Dim Ans As range, FindRng As range
    Dim LkFor As String
    Set ws = ActiveSheet
    Set FindRng = ws.range("ENTER YOUR RANGE")
    LkFor = "ENTER WORD TO FIND"
   
    Set Ans = FindRng.Find(what:=LkFor, LookIn:=xlValues, _
                    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
                  
                  If Not Ans Is Nothing Then
                     ws.range(ws.Cells(Ans.Row, Ans.Column), ws.Cells(ws.Cells(Rows.count, 4).End(xlUp).Row, Ans.Column)).Copy
       
                    Else
   
                  End If

End Sub

 

[Cr864]

Sub FindWrd()

    Dim ws As Worksheet
    Dim Ans As range, FindRng As range
    Dim LkFor As String
    Set ws = ActiveSheet
    Set FindRng = ws.range("ENTER YOUR RANGE")
    LkFor = "ENTER WORD TO FIND"
  
    Set Ans = FindRng.Find(what:=LkFor, LookIn:=xlValues, _
                    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
                 
                  If Not Ans Is Nothing Then
                     ws.range(ws.Cells(Ans.Row, Ans.Column), ws.Cells(ws.Cells(Rows.count, 4).End(xlUp).Row, Ans.Column)).Copy
      
                    Else
  
                  End If

End Sub

@gordsky Sorry for the late reply on this, i thought I'd be able to make that code work for myself but I'm having some issues because i didnt give you all the info.

Im working with this module below:

Option Explicit
Public Sub get200()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   
   Set DestWbk = ThisWorkbook
   
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   
   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)

   'SrcWbk.Sheets(1).Range("C8:C1000").Copy
   'DestWbk.Sheets("Main").Range("A1").PasteSpecial SkipBlanks:=True
   
   'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
   'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues
   
   SrcWbk.Close False
   
   Sheets(1).Activate
   
   
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
End Sub

I currently have a user select a file and it just copies the whole range from C8:C1000 ( i have it commented out from where i was trying your code). Ideally id like it to have the customer open their file and find the word "Instance" in the range "C1:C50" and then copy from that word to the bottom row and paste the data back into my original workbook on the sheet "Main" as seen in my code that is commented out above.

I'd tried playing around with the snippet you provided to make it work for what im doing but I must be missing something. Do you have any suggestions?

 

[gordsky]

This is not tested but should do what you want providing all your reference within your code are correct
I havent done anything with your second copy action as you havent said anything about it. See if this does what you need.

Option Explicit
Option compare text

Public Sub get200()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim Ans As range, FindRng As range
   Dim LkFor As String
   
   Set DestWbk = ThisWorkbook
   
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   
   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)

   'SrcWbk.Sheets(1).Range("C8:C1000").Copy
   'DestWbk.Sheets("Main").Range("A1").PasteSpecial SkipBlanks:=True
  
   Set FindRng = SrcWbk.Sheets(1).Range("C1:C50")
   LkFor = "Instance"
   
   Set Ans = FindRng.Find(what:=LkFor, LookIn:=xlValues, _
                   lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False)
                  
                  If Not Ans Is Nothing Then
                     SrcWbk.Sheets(1).range(SrcWbk.Sheets(1).Cells(Ans.Row, Ans.Column), SrcWbk.Sheets(1).Cells(SrcWbk.Sheets(1).Cells(Rows.count, "C").End(xlUp).Row, Ans.Column)).Copy

                  DestWbk.Sheets("Main").Range("A1").PasteSpecial SkipBlanks:=True 

                  end if 

   'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
   'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues
   
   SrcWbk.Close False
   
   Sheets(1).Activate
   
   
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
End Sub

 

[Cr864]

This is not tested but should do what you want providing all your reference within your code are correct
I havent done anything with your second copy action as you havent said anything about it. See if this does what you need.

Option Explicit
Option compare text

Public Sub get200()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim Ans As range, FindRng As range
   Dim LkFor As String
  
   Set DestWbk = ThisWorkbook
  
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
  
   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)

   'SrcWbk.Sheets(1).Range("C8:C1000").Copy
   'DestWbk.Sheets("Main").Range("A1").PasteSpecial SkipBlanks:=True
 
   Set FindRng = SrcWbk.Sheets(1).Range("C1:C50")
   LkFor = "Instance"
  
   Set Ans = FindRng.Find(what:=LkFor, LookIn:=xlValues, _
                   lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False)
                 
                  If Not Ans Is Nothing Then
                     SrcWbk.Sheets(1).range(SrcWbk.Sheets(1).Cells(Ans.Row, Ans.Column), SrcWbk.Sheets(1).Cells(SrcWbk.Sheets(1).Cells(Rows.count, "C").End(xlUp).Row, Ans.Column)).Copy

                  DestWbk.Sheets("Main").Range("A1").PasteSpecial SkipBlanks:=True

                  end if

   'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
   'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues
  
   SrcWbk.Close False
  
   Sheets(1).Activate
  
  
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
End Sub

Hey @gordsky ,

This seems to work! It did not work at first but i checked the source book and the data type was "General" instead of "Text" in the field that "Instance" was located, but after i changed it, it found it just fine. Is there a way to make it find that cell no matter what, even if the data type shows "General"

For the second part of the question, where i have this commented out:

   'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
   'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues

I'd still like to copy that range and paste it, how could i make it look at what row you found the word "Instance" in prior, and use that as the row that we start with I on? So instead of it being I8 in that commented range, make it I[InstanceRow]:Q1000?

You're a beast! Thanks for all your help and sorry again for slow replies

 

[Cr864]

Hey @gordsky ,

This seems to work! It did not work at first but i checked the source book and the data type was "General" instead of "Text" in the field that "Instance" was located, but after i changed it, it found it just fine. Is there a way to make it find that cell no matter what, even if the data type shows "General"

For the second part of the question, where i have this commented out:

   'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
   'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues

I'd still like to copy that range and paste it, how could i make it look at what row you found the word "Instance" in prior, and use that as the row that we start with I on? So instead of it being I8 in that commented range, make it I[InstanceRow]:Q1000?

You're a beast! Thanks for all your help and sorry again for slow replies

@gordsky I actually resolved that first issue, it wasn't the data type, it was the fact the cell was merged. So i just added a line to unmerge the whole column and it works completely fine now.

 

[gordsky]

@gordsky I actually resolved that first issue, it wasn't the data type, it was the fact the cell was merged. So i just added a line to unmerge the whole column and it works completely fine now.

which part do you still need help with

 

[Cr864]

which part do you still need help with

'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues

I'd still like to copy that range and paste it, how could i make it look at what row you found the word "Instance" in prior, and use that as the row that we start with I on? So instead of it being I8 in that commented range, make it I[InstanceRow]:Q1000?

Other than that, everything else looks golden! Sorry i didnt give you that info earlier

 

[gordsky]

'SrcWbk.Sheets(1).Range("I8:Q1000").Copy
'DestWbk.Sheets("Main").Range("B1").PasteSpecial xlPasteValues

I'd still like to copy that range and paste it, how could i make it look at what row you found the word "Instance" in prior, and use that as the row that we start with I on? So instead of it being I8 in that commented range, make it I[InstanceRow]:Q1000?

Other than that, everything else looks golden! Sorry i didnt give you that info earlier

I think if you change the range to

SrcWbk.Sheets(1).Range("I" & ans.row & ":Q1000").Copy