run-time error '-2147221080 (800401a8)': Automation error

412 views excel
7

I'm getting the above error message trying to run this macro: (Sorry about the size and messy state) * <- means data removed for protection

Private Sub CommandButton1_Click()

' Button to select one client from "Search Result" and fill their information in "Client Details"

'On Error GoTo CloseDataPool

' Make sure the Client Number cell is empty

If Range("B2") = "" Then
MsgBox ("Please enter valid client number")
Exit Sub
End If

' Give row value to Client Number
Search_Result = 4 + Range("B2")
If Cells(Search_Result, 1) <> Range("B2") Then
MsgBox ("Please enter valid client number")
Exit Sub
End If

' Find client in Data Pool via Broker Reference, then find their row number

Workbooks.Open "C:\Users\*\Dropbox\Shared Folder AT TH DH\Savant\*\Data Pool.xlsx"

Dim RC As Workbook
Dim DPW As Workbook
Dim DP As Worksheet
Dim SR As Worksheet
Dim CD As Worksheet
Dim PFDP As Worksheet
Set DPW = Workbooks("Data Pool")
Set DP = DPW.Worksheets("Data Pool")
Set RC = Workbooks("*")
Set SR = RC.Worksheets("Search Results")
Set CD = RC.Worksheets("Client Details")
Set PFDP = DPW.Worksheets("Prospect Fleet Data Pool")
Set PLDP = DPW.Worksheets("Prospect Liability Data Pool")

' Protect workbook and worksheets
CD.Protect Password:="*", UserInterfaceOnly:=True
SR.Protect Password:="*", UserInterfaceOnly:=True
DP.Protect Password:="*", UserInterfaceOnly:=True
PFDP.Protect Password:="*", UserInterfaceOnly:=True
PLDP.Protect Password:="*", UserInterfaceOnly:=True
RC.Protect Password:="*", Structure:=True
DPW.Protect Password:="*", Structure:=True

Search_Result = SR.Range("B2") + 4
x = DP.Cells(Rows.count, 1).End(xlUp).Row + 1
For Each Rowcheck In DP.Range("B2:B" & x)
If Rowcheck = SR.Range("B" & Search_Result) Then
y = Rowcheck.Row

CD.Range("E16") = DP.Cells(y, 1) 'Company Name
CD.Range("F38") = DP.Cells(y, 4) 'User added by
CD.Range("L38") = DP.Cells(y, 5) 'Date added on
End If
Next Rowcheck

Search_Result = CD.Range("F8")

Polcol = 2
Polrow = 45
x = PFDP.Cells(Rows.count, 1).End(xlUp).Row + 1
For Each Rowcheck In PFDP.Range("A2:A" & x)
If Rowcheck = Search_Result Then
y = Rowcheck.Row
CD.Cells(Polrow, Polcol) = Polrow - 44
CD.Cells(Polrow, Polcol + 2) = PFDP.Cells(y, 3)
Polrow = Polrow + 1
End If
Next Rowcheck

x = PLDP.Cells(Rows.count, 1).End(xlUp).Row + 1
For Each Rowcheck In PLDP.Range("A2:A" & x)
If Rowcheck = Search_Result Then
y = Rowcheck.Row
CD.Cells(Polrow, Polcol) = Polrow - 44
CD.Cells(Polrow, Polcol + 2) = PLDP.Cells(y, 3)
Polrow = Polrow + 1
End If
Next Rowcheck

'Add to history log
Set HLD = DPW.Worksheets("History Log")
HLD.Protect Password:="*", UserInterfaceOnly:=True
HLDR = HLD.Cells(Rows.count, 1).End(xlUp).Row + 1
HLD.Cells(HLDR, 1) = CD.Range("F8")

GoTo EndSub
CloseDataPool:
MsgBox ("An error has occurred")
EndSub:
Workbooks("Data Pool.xlsx").Save
Workbooks("Data Pool.xlsx").Close

End Sub

The line that's showing the error is:

Set HLD = DPW.Worksheets("History Log")

I've attempted to move this line near the start where I set the other Worksheets instead. I also move the protection line near the start as well. When I do this, the error reoccurs but on the next line down:

HLDR = HLD.Cells(Rows.count, 1).End(xlUp).Row + 1

I've also added a line just above to open the Data Pool workbook as whilst googling, I saw the error can occur by looking for items in a closed workbook. However, the error still persists.

I've looked around and I cannot find a solution. Can someone assist me in understanding this error?

answered question

1 Answer

3

Write Dim HLD as Worksheet before the line with the error.

posted this

Have an answer?

JD

Please login first before posting an answer.