forked from AllenMattson/VBA_personal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
FixRangeError.vb
70 lines (51 loc) · 2.22 KB
/
FixRangeError.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Option Explicit
Sub FixRangeError()
On Error GoTo FixRangeError_Error
Dim r_range As Range
Dim str_text As String
Dim l_counter As Long
Dim str_result As String
Dim arr_result As Variant
Dim arr_range As Variant
For Each r_range In ActiveSheet.UsedRange
str_text = ""
If r_range.HasFormula Then
ReDim arr_result(0)
str_text = Replace(r_range.Formula, "=", "")
arr_range = Split(str_text, "+")
For l_counter = LBound(arr_range) To UBound(arr_range)
If Not InStr(arr_range(l_counter), "#") > 0 Then
ReDim Preserve arr_result(UBound(arr_result) + 1)
arr_result(UBound(arr_result)) = arr_range(l_counter)
End If
Next l_counter
For l_counter = LBound(arr_result) + 1 To UBound(arr_result)
str_result = str_result & "+" & arr_result(l_counter)
Next l_counter
str_result = "=" & Right(str_result, Len(str_result) - 1)
r_range.Formula = str_result
End If
Next r_range
On Error GoTo 0
Exit Sub
FixRangeError_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FixRangeError of Sub Modul1"
End Sub
'---------------------------------------------------------------------------------------
' Method : FindMeTheCellWithError
' Author : v.doynov
' Date : 01.09.2017
' Purpose: Show the errors. Print the errors in a worksheet. Look for errors. Search errors.
'---------------------------------------------------------------------------------------
Public Sub FindMeTheCellWithError()
Dim rngCell As Range
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
For Each rngCell In wks.UsedRange
If IsError(rngCell) Then
Debug.Print rngCell.Address
Debug.Print rngCell.Parent.name
End If
Next rngCell
Next wks
End Sub