Using Find and Resize to transpose values error

dreen

Board Regular
Joined
Nov 20, 2019
Messages
52
I am trying to take my current code, that uses a Find function to search for the value in cell "H4" (this value is in the worksheet where the code is) and find it in a second workbook searching from Columns A3-A100000 (Find functions start at the next row after the first, hence why in my code I have written A2:A100000 as my Find Range). Once the value is found, I would like to transpose the resize values of the Find match in the second workbook (with an offset of 5 columns to start transposing values from column F ).

My code works but I am trying to further simplify my code and possibly speed it up by not declaring so many variables and eliminating stepping through so much code.
I currently have:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim Key As Range

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  If Not Intersect(Target, Range("E4:E5")) Is Nothing Then

  Application.EnableEvents = False

  Set sh1 = ThisWorkbook.Worksheets("Operator")
  Set wb2 = Workbooks.Open(Filename:="\\schaeffler.com\stratford\DATA\NEA-FBA-P\Projects\SetupSheets\Databases\Database_IRR 200-2S.xlsm", Password:="123")
  Set sh2 = wb2.Sheets("Changes")
  Set Key = sh2.Range("A2:A100000").Find(sh1.Range("H4"), , xlValues, xlWhole)
  sh1.Unprotect "123"

  If Not Key Is Nothing Then

    sh1.Range("N31").Resize(85).Value = Application.Transpose(Key.Offset(, 5).Resize(, 85).Value)
  Else

    sh1.Range("N31").Resize(85).ClearContents

  End If

  sh1.Protect "123"
  wb2.Close False

  End If

  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True

End Sub

I am trying to replace the above code with the following below, but it's producing the following error: Run-time error '91': Object Variable or With block variable not set

Here is the code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  If Not Intersect(Target, Range("E4:E5")) Is Nothing Then

  Application.EnableEvents = False
  Sheet1.Unprotect "123"
Sheet1.Range("N31").Resize(85).Value = Application.Transpose(Workbooks.Open(Filename:=" \Databases\Database_IRR 200-2S.xlsm", Password:="123").Worksheets("Changes").Range("A2:A100000").Find(sh1.Range("H4"), , xlValues, xlWhole).Offset(, 5).Resize(, 85).Value)
  Sheet1.Protect "123"

  End If

  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True

End Sub


I have also posted this on another forum to get their opinion as well:
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Forum statistics

Threads
1,223,248
Messages
6,171,027
Members
452,374
Latest member
keccles

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