VBA Find function help

[FrEaK_aCcIdEnT]

I am having trouble with this... I have fiddled with the find function a lot and no luck.

I need to find a string from workbooks("book1").cell.("E1") in workbooks.("book2").range("A1:AAZ1).

Once found Offset.(0,-1).activate. (the cell below what it found)
Then copy the active cell and the 8 cells below it.

Then workbooks.("book1").activate
cells.("I5").select.selection.paste


I am getting better at VBA, but this find function is eating my lunch...

If someone else has the Excel 2010 Power Programming with VBA, and could point me to the right page, I would appreciate that too. I am not above having to figure it out on my own with guidence from others.

Thanks!!

 

[JackDanIce]

Offset(0, -1).Activate will select the cell LEFT of what is found, not below what is found. Try the following code, but I suspect it won't work becuase I'm unclear what range you want to copy and paste:

Dim Search_Item as Range: Set Search_Item = Workbooks("book1").Sheets("Sheet1").Range("E1")
Dim Search_Range as Range: Set Search_Range =  = Workbooks("book2").Sheets("Sheet1").Range("A1:AAZ1")
Dim rng as Range

On Error Resume Next
Set rng = Search_Range.Find(What:=Search_Item, LookIn:=xlvalues, LookAt:=xlWhole)
On Error Goto 0

If rng = Nothing Then
   Set Search_Item = Nothing: Set Search_Range = Nothing
   Msgbox "Item not found"   
   Exit Sub
End If

rng.Offset(1).Resize(8).Copy
Search_Item.Offset(4, 4).PasteSpecial xlPasteValues

Set Search_Item = Nothing: Set Search_Range = Nothing: Set rng = Nothing

 

[FrEaK_aCcIdEnT]

Offset(0, -1).Activate will select the cell LEFT of what is found, not below what is found. Try the following code, but I suspect it won't work becuase I'm unclear what range you want to copy and paste:

Dim Search_Item as Range: Set Search_Item = Workbooks("book1").Sheets("Sheet1").Range("E1")
Dim Search_Range as Range: Set Search_Range =  = Workbooks("book2").Sheets("Sheet1").Range("A1:AAZ1")
Dim rng as Range

On Error Resume Next
Set rng = Search_Range.Find(What:=Search_Item, LookIn:=xlvalues, LookAt:=xlWhole)
On Error Goto 0

If rng = Nothing Then
  Set Search_Item = Nothing: Set Search_Range = Nothing
   Msgbox "Item not found"   
   Exit Sub
End If

rng.Offset(1).Resize(8).Copy
Search_Item.Offset(4, 4).PasteSpecial xlPasteValues

Set Search_Item = Nothing: Set Search_Range = Nothing: Set rng = Nothing

It gets hung up at the If statement line. I have tried removing it, but that did not work either.

I do appreciate the help!

Edit: This is what comes up with this line hanging up.

Run-Time Error '91'
Object variable or with block variable not set

 

[JackDanIce]

My mistake, a typo, change that line in red to:

IF rng is Nothing Then

I used "=" instead of "is"

 

[FrEaK_aCcIdEnT]

I have played with it and got it to return the "Item not Found" message. Here is where I at: (This is just a portion of the module code)

Code:

Criteria = ActiveWorkbook.Name
Dim Search_Item As Range
Dim Search_Range As Range
Set Cycle = Workbooks(OtherBook).Sheets(1).Range("E1")
Set Search_Range = Workbooks(Criteria).Sheets(1).Range("A1:AAZ1")
Dim rng As Range
On Error Resume Next
Set rng = Search_Range.Find(What:=Cycle, After:=ActiveCell, LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    If rng is Nothing Then
        Set Search_Item = Nothing: Set Search_Range = Nothing
        MsgBox "Cound not find cycle " & Cycle
        End If
rng.Offset(1).Resize(8).Select
Selection.Copy

I don't understand why it cant locate the criteria. I have tried changing the search order by rows and columns. The match for the Cycle was located in cell("J1") on the workbooks(Criteria).

also changed the "=" to "is"

 

[JackDanIce]

There are bits in there that aren't in the code I suggested, specifically you don't need to use .Select or .Activate. Try:

Criteria = ActiveWorkbook.Name
Dim Search_Item As Range
Dim Search_Range As Range
Set Cycle = Workbooks(OtherBook).Sheets(1).Range("E1")
Set Search_Range = Workbooks(Criteria).Sheets(1).Range("A1:AAZ1")
Dim rng As Range
On Error Resume Next
Set rng = Search_Range.Find(What:=Cycle, After:=ActiveCell, LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        Set Search_Item = Nothing: Set Search_Range = Nothing
        MsgBox "Cound not find cycle " & Cycle
    End If
rng.Offset(1).Resize(8).Copy

Whether this fixes your problem I don't know and would need to see the workbook to solve if this doesn't work.. Asking the obvious but are both workbooks open in the same Excel Windows session?

 

[FrEaK_aCcIdEnT]

I open the files individually--but yes, they are open at the same time. There is also a 3rd excel file open. All the variables are declared, it just doesnt locate the string for some reason. The cell(E1) that it is getting the string from is a formula. =Left() to extract just the search criteria that it needs. Would this affect the outcome of the find function?

It comes up with the "Could not find" and displays the proper string.

I do appreciate your help Jack!

 

[JackDanIce]

Hmm not sure what to suggest without having your workbooks in front of me. Try changing the line to:

Set Cycle = Workbooks(OtherBook).Sheets(1).Range("E1").Value

I doubt that'll fix it but if there's a formula in there, this will take just the value of the output, although implies Cycle is of data type String?
Also try this:

Set rng = search_range.Find(What:=Cycle, After:=Workbooks(Criteria).Sheets(1).Range("A1"), LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext)

Again, I'm not confident this will fix it but worth trying..

 

[FrEaK_aCcIdEnT]

Here is the full code. I had tried the .value yesterday, but it did not work. I just tried the aftercell:= and it didn't work either. Even though it doesn't find the string I am having it search for, it completed the process to the end sub without any run time errors.

If there is a better way to accomplish what I am trying to do, let me know and I will research that and learn it. Thanks again Jack!

Sub ChartVerification()
'
' SheetName Macro
'
' Keyboard Shortcut: Ctrl+d
'
    Dim j As Long
    Dim OtherBook As String
'
    OtherBook = ActiveWorkbook.Name
'
    ActiveSheet.Paste
    Range("A1") = "Change"
'remove all columns that do not have a load T/C present
For j = 23 To 9 Step -1
    If WorksheetFunction.Max(Range(Cells(9, j), Cells(23, j))) > 2450 Then Columns(j).Delete
Next j
'Extract the run number for the Sheetname
    Range("C1").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = "=RIGHT(R[2]C[-2],8)"
'series to extract just the cycle number for search reference in Criteria.xls
    Range("D1").Select
        With Selection.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
    ActiveCell.FormulaR1C1 = "=RIGHT(R[3]C[-3],LEN(R[3]C[-3])-8)"
    Range("D2").Select
        With Selection.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(R[-1]C[0],""Orig."",1,1)"
    Range("E1").Select
        With Selection.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
    ActiveCell.FormulaR1C1 = "=LEFT(R[1]C[-1],LEN(R[1]C[-1])-8)"
'search Criteria.xls for cycle number and copy the verification ctiteria back to Chart Template workbook.
    Workbooks.Open Filename:="Will put the file path back before running again."
    Criteria = ActiveWorkbook.Name
Dim Search_Item As Range
Dim Search_Range As Range
Set Cycle = Workbooks(OtherBook).Sheets(1).Range("E1")
Set Search_Range = Workbooks(Criteria).Sheets(1).Range("A1:AF1")
Dim rng As Range
On Error Resume Next
Set rng = Search_Range.Find(What:=Cycle, After:=Workbooks(Criteria).Sheets(1).Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If rng Is Nothing Then
        Set Search_Item = Nothing: Set Search_Range = Nothing
        MsgBox "Cound not find cycle " & Cycle
        End If
rng.Offset(1).Resize(8).Copy
    Workbooks(OtherBook).Activate
    Range("I5").Select
    Selection.Paste
'Close Criteria workbook and rename sheet tab for header title.
Workbooks(Criteria).Close False
Workbooks(OtherBook).Activate
   NewName = Range("C1").Value
ActiveSheet.Name = NewName
End Sub

 

[JackDanIce]

Made a few improvements to your code, but can't find anything specific to solve your problem.

- Make sure you put the full path and file name for when you open Criteria.xls

Try running this and let me know what happens:

Sub ChartVerification_v1()
'
' SheetName Macro

' Keyboard Shortcut: Ctrl+d


Dim j As Long
Dim OtherBook As String: OtherBook = ActiveWorkbook.Name
Application.ScreenUpdating = False

ActiveSheet.Paste
Range("A1") = "Change"

'Remove all columns that do not have a load T/C present
For j = 23 To 9 Step -1
    If WorksheetFunction.Max(Range(Cells(9, j), Cells(23, j))) > 2450 Then Columns(j).Delete
Next j

'Extract the run number for the Sheetname
With Range("C1")
    With .Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    .FormulaR1C1 = "=RIGHT(R[2]C[-2],8)"
End With
    
'Series to extract just the cycle number for search reference in Criteria.xls
With Range("D1")
    With .Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    .FormulaR1C1 = "=RIGHT(R[3]C[-3],LEN(R[3]C[-3])-8)"
End With

With Range("D2")
    With .Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    .FormulaR1C1 = "=SUBSTITUTE(R[-1]C[0],""Orig."",1,1)"
End With

With Range("E1")
    With .Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    .FormulaR1C1 = "=LEFT(R[1]C[-1],LEN(R[1]C[-1])-8)"
End With

'Search Criteria.xls for cycle number and copy the verification ctiteria back to Chart Template workbook.
Workbooks.Open FileName:="Will put the file path back before running again."

Dim Criteria As String: Criteria = ActiveWorkbook.Name
Dim Search_Item As Range: Set Cycle = Workbooks(OtherBook).Sheets(1).Range("E1")
Dim Search_Range As Range: Set Search_Range = Workbooks(Criteria).Sheets(1).Range("A1:AF1")
Dim rng As Range

On Error Resume Next
Set rng = Search_Range.Find(What:=Cycle, After:=Workbooks(Criteria).Sheets(1).Range("A1"), LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
On Error GoTo 0

If rng Is Nothing Then
    MsgBox "Cound not find cycle " & Cycle & " macro stopping"
    Exit Sub
End If

rng.Offset(1).Resize(8).Copy
Workbooks(OtherBook).Activate
Range("I5").PasteSpecial xlPasteValues

'Close Criteria workbook and rename sheet tab for header title.
Workbooks(Criteria).Close False
Workbooks(OtherBook).Activate
ActiveSheet.Name = Range("C1").value

Application.ScreenUpdating = True

End Sub