VBA Find function help

F

FrEaK_aCcIdEnT

Board Regular
Joined
May 1, 2012
Messages
100
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...:confused:

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!!
 
Sort by date Sort by votes
I even tried changing the code so that cell (E1)'s value was set to 1.(No Formula) Then changed cell (B1) in workbooks.(Criteria) to 1. Left cell(A1) as the active cell when I saved it. Ran the code an it still didn't find the 1...

I also tried to remove the entire If from the find method and stopped it before it closed the workbooks(Criteria). Checked the workbooks(Criteria) and cell(A1) was still the active cell. Like it didn't even try to find it. This was all with the (E1).value of 1.

I don't think it is something with the formula since I get the same results without it being a factor.
 
Last edited:
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
JackDanIce said:
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:
Rich (BB code): 
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
Click to expand...

I tried the code as written and it just exited the sub. That did help with having to reset everything every time I wanted to test a change. lol

I changed a couple things and tried the below code. It didnt find what I wanted, but is did hoewver offset the (A1:AF1) range properly and copy (A2:AF10) back in to the workbooks(Otherbook). So now it is completely down to the find method locating the cell.

You have been a great help Jack!

Code: 
Sub ChartVerification()
'
' SheetName Macro
'
' Keyboard Shortcut: Ctrl+d
'
Dim j As Long
Dim OtherBook As String: OtherBook = ActiveWorkbook.Name
Application.ScreenUpdating = False

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

'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 Change"
Dim Criteria As String: Criteria = ActiveWorkbook.Name
Dim Search_Item As Range: Set Cycle = Workbooks(OtherBook).Sheets(1).Range("E1")
[B]Range("A1:AF1").Select[/B]

On Error Resume Next
[B]Selection[/B].Find(What:=Cycle, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)[B].Select

[/B]On Error GoTo 0

[B]Selection.[/B]Offset(1).Resize(9).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
 
Last edited:
Upvote 0
JackDanIce said:
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:
Rich (BB code): 
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
With Range("E1")
    .Value = VBA.Replace(.Text, " ", "")
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
Click to expand...



Hey Jack, I got it!!!

Line in RED was leaving 1 or 2 spaces at the end of the search criteria. I had to remove the spaces by adding the BLUE

(y)
 
Upvote 0
Gotta scroll through the code I quoted into the reply. I changed the colors on the lines of code that were the cause and the fix.

Code: 
[B][COLOR=#ff0000].FormulaR1C1 = "=LEFT(R[1]C[-1],LEN(R[1]C[-1])-8)"
[/COLOR][/B]End With
[COLOR=#0000ff][B]With Range("E1")
    .Value = VBA.Replace(.Text, " ", "")
End With
[/B][/COLOR]
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
VBA codes to replace all cells containing a certain value
Replies
2
Views
139
Snakehips
Snakehips
D
  • Solved
VBA Conditional Statement That Functions Based on Today's Date
2
Replies
18
Views
268
Cubist
Cubist
BAKELOVEMORE
  • Solved
SEARCHING ANOTHER WORKBOOK FOR CURRENT ACTIVE TEXT OFFSET AND RETURNING TEXT FROM 3 CELLS OFFSET FROM FOUND TEXT
2
Replies
11
Views
223
BAKELOVEMORE
BAKELOVEMORE
N
  • Solved
Macro Replicating AutoSum Functionality
Replies
3
Views
135
Joe4
Joe4
M
  • Question
Match cell contents exactly for find and replace based on a table
Replies
3
Views
139
mumps
mumps

Forum statistics

Threads
1,216,101
Messages
6,128,842
Members
449,471
Latest member
lachbee

Share this page

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