I have VBA code that prompts a user to select the workbook from a location. I want to add error handling so that if they choose an incorrect file based on the worksheets then apply a message box "wrong file" and re-enable the prompt to choose a new file.
As you can see below I've already set what the existing names of the worksheets should be if they select the correct workbook.
Sub Button4_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim strFileName As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws1A As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim cell As Range
Dim rng As Range
Dim rng2 As Range
Dim RangeName As String
Dim CellName As String
Dim ValueToFind
Dim dstRng As Range
Dim NewFile As Variant
'prompt folder location
NewFile = Application.GetOpenFilename("microsoft excel files (*.xlsm*), *.xlsm*")
If NewFile <> False Then
Set wb1 = Workbooks.Open(NewFile)
'apply error handeling if user does not select a file
Else
MsgBox "No/Wrong File Selected. Program Will Exit."
Application.DisplayAlerts = False
Exit Sub
End If
Set wb2 = ThisWorkbook
Set ws2 = wb2.Sheets("Output")
Set ws1 = wb1.Sheets("RVP Local GAAP")
Set rng = Range("CurrentTaxPerLocalGAAPProvision")
Set rng2 = Range("CurrentTaxPerGroupGAAPProvision")
Set ws1A = wb1.Sheets("RVP Group GAAP")
'Loop through all the values in NamedRange
For Each rng In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1.Range(rng.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1.Range("CurrentTaxPerLocalGAAPProvision")) Is Nothing Then
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng.Offset(0, 1).Value
Else
End If
End If
Next
For Each rng2 In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1A.Range(rng2.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1A.Range("CurrentTaxPerGroupGAAPProvision")) Is Nothing Then
''MsgBox "succesful"
''found = False
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng2.Offset(0, 1).Value
Else
End If
End If
Next
MsgBox "Values have copied over sucessfully"
ActiveWindow.FreezePanes = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
As you can see below I've already set what the existing names of the worksheets should be if they select the correct workbook.
Sub Button4_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim strFileName As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws1A As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim cell As Range
Dim rng As Range
Dim rng2 As Range
Dim RangeName As String
Dim CellName As String
Dim ValueToFind
Dim dstRng As Range
Dim NewFile As Variant
'prompt folder location
NewFile = Application.GetOpenFilename("microsoft excel files (*.xlsm*), *.xlsm*")
If NewFile <> False Then
Set wb1 = Workbooks.Open(NewFile)
'apply error handeling if user does not select a file
Else
MsgBox "No/Wrong File Selected. Program Will Exit."
Application.DisplayAlerts = False
Exit Sub
End If
Set wb2 = ThisWorkbook
Set ws2 = wb2.Sheets("Output")
Set ws1 = wb1.Sheets("RVP Local GAAP")
Set rng = Range("CurrentTaxPerLocalGAAPProvision")
Set rng2 = Range("CurrentTaxPerGroupGAAPProvision")
Set ws1A = wb1.Sheets("RVP Group GAAP")
'Loop through all the values in NamedRange
For Each rng In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1.Range(rng.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1.Range("CurrentTaxPerLocalGAAPProvision")) Is Nothing Then
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng.Offset(0, 1).Value
Else
End If
End If
Next
For Each rng2 In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1A.Range(rng2.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1A.Range("CurrentTaxPerGroupGAAPProvision")) Is Nothing Then
''MsgBox "succesful"
''found = False
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng2.Offset(0, 1).Value
Else
End If
End If
Next
MsgBox "Values have copied over sucessfully"
ActiveWindow.FreezePanes = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub