I have data in Column A in excel..I am iterating through column and i need to find if a cell value has hyperlink init.
LR=Activeworkbook.Worksheets("Emp").Range("A65000").End(xlup).Row
for j=1 to LR
if Thisworkbooks.Worksheets("Emp").cells(j,1)="" then 'Logic to find hyperlink
'Function
end if
next
Identify Cells Containing Hyperlinks
As Red Hare already mentioned in the comments, it is best tested with something like the following:
Dim cell As Range: Set cell = Sheet1.Range("A1")
If cell.Hyperlinks.Count > 0 Then ' has a hyperlink
Else ' has no hyperlink
End If
that is, using the Hyperlinks.Count property of the Hyperlinks object returned by the cell's Hyperlinks property which is a collection of hyperlinks in a range (in this case, a single cell). For a single cell, the Count property will return only 0 or 1 so you could actually use
If cell.Hyperlinks.Count = 1 Then ' has a hyperlink
instead.
Example Code
Option Explicit
Sub IdentifyCellsWithHyperlink()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' If it's not, modify accordingly.
Dim ws As Worksheet: Set ws = wb.Worksheets("Emp")
Dim rg As Range
Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim cell As Range
For Each cell In rg.Cells
If cell.Hyperlinks.Count > 0 Then ' has a hyperlink
Else ' has no hyperlink
End If
Next cell
End Sub
Here is something that can be used to run through each row to determine if it can be set as a hyperlink. Kinda hard to figure out what the range of possible solutions are that will work for you without fully understanding the context...
Private Sub cmdFollowLink_Click()
CreateHyperlink Me!cmdFollowLink, Me!txtSubAddress, _
Me!txtAddress
End Sub
Sub CreateHyperlink(ctlSelected As Control, _
strSubAddress As String, Optional strAddress As String)
Dim hlk As Hyperlink
Select Case ctlSelected.ControlType
Case acLabel, acImage, acCommandButton
Set hlk = ctlSelected.Hyperlink
With hlk
If Not IsMissing(strAddress) Then
.Address = strAddress
Else
.Address = ""
End If
.SubAddress = strSubAddress
.Follow
.Address = ""
.SubAddress = ""
End With
Case Else
MsgBox "The control '" & ctlSelected.Name _
& "' does not support hyperlinks."
End Select
End Sub
Goood afternoon,
I would like to do the quick check of my workbook in order to detect potential #REF! values.
I found some good solution here:
Find all matches in workbook using Excel VBA
but when I apply it it changes all the values found.
I need something, which will inform me, that the unwanted value appear.
In this event I modified the following code:
Sub FindAndExecute()
Dim Sh As Worksheet
Dim Loc As Range
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:="#REF!")
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
If Loc = True Then
MsgBox ("Error found")
End If
'Loc.Value = "Answered!"
Set Loc = .FindNext(Loc)
Loop
End If
End With
Set Loc = Nothing
Next
End Sub
But I see no reaction. Is there any way to pop up the messagebox when the #REF value is found throughout the workbook?
I have been using FindLink from Bill Manville Associates for a long time now, and it has always been quite useful.
It gives warnings as you mean.
You can use it as it is. I am not sure you can access its code.
If a cell in Excel contains an formula with an error, it's content is not #NAME?or #REF! or something like that - this is only the way excel displays such errors. Therefore, searching for the string #REF! will not find anything.
There is an easy command that lets you find all cells containing errors - see the following code (assuming sh set to the sheet you want to look at)
Dim cell As Range
For Each cell In sh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
Debug.Print cell.Address, cell.Formula
Next cell
Update: As BigBen points out, I was wrong with the text search for #REF, you can in fact use Find to find invalid references.
If your code doesn't find anything, maybe you have to provide the parameter LookAt :=xlPart.
The Find-method, however, will not find any other types of error like #NAME? or #DIV/0, while the SpecialCells will find all kind of errors in a real easy way.
Update2 The following code will loop over all sheets and list all cells in error. I have also added some code to check if a sheet has any cell in error - if not, the SpecialCells will raise a runtime error - to avoid that I have put the statement into a On Error Resume Next-statement.
Sub FindAndExecute()
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
Dim cell As Range, allCellsInError As Range
Set allCellsInError = Nothing
On Error Resume Next
Set allCellsInError = Sh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error Goto 0
If Not allCellsInError Is Nothing Then
For Each cell In allCellsInError
Debug.Print Sh.Name; cell.Address; cell.Formula
Next cell
End If
Next
End Sub
Your current code is actually about as efficient as can be, it just needs a couple of additions to show you where the errors were located.
Sub FindAndExecute()
Dim Sh As Worksheet, errorSheet As Worksheet
Dim Loc As Range
Dim i As Integer
Dim lastFound As String
ThisWorkbook.Worksheets.add after:=Sheets(Sheets.Count)
Set errorSheet = Sheets(Sheets.Count)
errorSheet.Name = "Errors " & Format(Now(), "hh_mm_ss")
i = 1
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:="#REF!")
If Not Loc Is Nothing Then
Do
Set Loc = .FindNext(Loc)
If Not Loc Is Nothing Then
errorSheet.Cells(i, 1) = "Error on sheet " & Loc.Parent.Name & _
" in cell " & Replace(Loc.Address, "$", "")
i = i + 1
lastFound = Loc.Address
End If
Loop While Not Loc Is Nothing And lastFound <> Loc.Address
End If
End With
Set Loc = Nothing
Next
If i = 1 Then errorSheet.Cells(1, 1) = "No errors were found"
End Sub
So first we add a sheet ThisWorkbook.Worksheets.add to hold the list of errors.
We use a counter i As Integer to keep track of the amount of errors found If i = 1 Then errorSheet.Cells(1, 1) = "No errors were found" and also to track the next free row on the error list errorSheet.Cells(i, 1).
Lastly we use the address property of the Range class to indicate which cell the Find method located: Loc.Address. I've used the Replace method to get rid of the absolute qualifiers $ as the address property will prefix the cell and row with them e.g. $A$1.
But I see no reaction. Is there any way to pop up the messagebox when the #REF value is found throughout the workbook?
Gives message boxes and selects/activates each Ref as it finds, and asks you on each if you wish to deal with.
When one of the cells in error is your specific value ("#REF!" in your case) then actives it.
See version 2 below which is the better version (even if it does employ goto for the current processed refs)
For Each cell In allCellsInError
If cell.Text = "#REF!"
Set myCell = cell
Sh.Activate 'I think you can live without this.
myCell.Select
Is the part the does it. When one of the cells in error is your specific value ("#REF!") then actives it.
Throughout the execution of code, when a particular value (Ref in your case) is found, its accompanied by a message box and question-answer choice if you want to deal with (which would effectively terminate the program and activate said cell containing that ref).
Sub FindAndExecute11()
Dim Sh As Worksheet
Dim answer As VbMsgBoxResult
Dim myCell As Range 'this had to be declared to make the activations work (not for the loops ! which uses cell)
Set DataRange = ActiveSheet.UsedRange 'I think you can remove this
Dim myArray() As Variant
Dim x As Long
refcount = 0
For Each Sh In ThisWorkbook.Worksheets
Dim cell As Range, allCellsInError As Range
Set allCellsInError = Nothing
On Error Resume Next
Set allCellsInError = Sh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Not allCellsInError Is Nothing Then
For Each cell In allCellsInError
If cell.Text = "#REF!" Then ''only printong the refs (igniring all other errors)
Set myCell = cell 'You need this for real time in the loop activations-selections of said cell
Sh.Activate 'I think you can live without this.
myCell.Select
refcount = refcount + 1
ReDim Preserve myArray(x)
myArray(x) = Sh.Name & cell.Address
x = x + 1
MsgBox "Ref Found in " & cell.Address & " " & Sh.Name
Debug.Print Sh.Name; cell.Address; cell.Formula
answer = MsgBox("Do you want to go to cell" & cell.Address & " and fix?", vbYesNo)
If answer = vbYes Then
Sh.Activate
cell.Select
Exit Sub
Else
'MsgBox "No"
End If 'must thank also - https://www.automateexcel.com/vba/yes-no-message-box/ - for this
End If
Next cell
End If
Next
'the following creates a new sheet after your sheets, and dumps contents of array (the Ref locations found) into it. It will only do this if all the Ref's are worked through and youve said "no" to dealing with them. In my 2nd version (to come) I will attempt to get a worksheet dump of all ref's no matter where you are in the procedure/process.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
'Range("A1:A" & UBound(myArray)).Value = myArray(x)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
'With sheet
'End With
Next x
With ActiveSheet
For x = 1 To UBound(myArray)
Cells(x, 1).Value = myArray(x)
Next x
End With
End Sub
More happy with the above code, working adapted from User #FunThomas' version.
But Here (below , version 2) is where I deal with the collection and print out of the REFs UP TO THE POINT you are in the execution of the program (so where you said yes, it stops code and prints out the found refs up to that point, If you never say yes, it will print out all the found refs when finished). With "dreaded" goto labels. (Its known that the COMMUNITY OF PROGRAMMERS say never use GOTO statements or logic. Using GOTO (or subroutines) they say it is a sign of ill-designed program and coding [I do not agree. not always.] - However I'm strapped for time). However-so, the only way I could get out the refs dealt with, in Output Worksheet to print , WHILE YOUR IN THE MIDDLE OF YOUR PROCESS ( message boxes) (so that it also prints out the refs found up to that point) was to use GOTO in the code:
Also removed one of the message boxes in this version as it wasn't necessary, so you have only got one. I like this version better as it seems to do everything you & everyone wish.
version 2: where all the action happens around/in/because of:
answer = MsgBox("Do you want to go to cell " & Sh.Name & cell.Address & " and fix?", vbYesNo)
answer variable defined previously as a VbMsgBoxResult
But both versions I have used a counter to count the specific refs and an array to store their positions (that way you can print out the array values as its doing in a final sheet) within the nested ifs in the for each sh loop.
Sub FindAndExecuteVersion2()
Dim Sh As Worksheet
Dim answer As VbMsgBoxResult
Dim myCell As Range 'this had to be declared to make the activations work (not for the loops ! which uses cell)
Set DataRange = ActiveSheet.UsedRange 'I think you can remove this
Dim myArray() As Variant
Dim x As Long
refcount = 0
For Each Sh In ThisWorkbook.Worksheets
Dim cell As Range, allCellsInError As Range
Set allCellsInError = Nothing
On Error Resume Next
Set allCellsInError = Sh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Not allCellsInError Is Nothing Then
For Each cell In allCellsInError
If cell.Text = "#REF!" Then ''only printong the refs (igniring all other errors)
Set myCell = cell 'You need this for real time in the loop activations-selections of said cell
Sh.Activate 'I think you can live without this.
myCell.Select
refcount = refcount + 1
ReDim Preserve myArray(x)
myArray(x) = Sh.Name & cell.Address
x = x + 1
'' MsgBox "Ref Found in " & cell.Address & " " & Sh.Name
Debug.Print Sh.Name; cell.Address; cell.Formula
answer = MsgBox("Do you want to go to cell " & Sh.Name & cell.Address & " and fix?", vbYesNo)
If answer = vbYes Then
Sh.Activate
cell.Select
GoTo Line1
Exit Sub
Else
'MsgBox "No"
'GoTo Line1
End If 'must thank also - https://www.automateexcel.com/vba/yes-no-message-box/ - for this
End If
Next cell
End If
Next
Line1:
'This section outputs the array of found refs upto the point you got to in the message boxes (either the whole thing if you say no to all, or from where you said ok yes deal with) on a sheet after all the other sheets. Basically its a screen dump of the console.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
For y = LBound(myArray) To UBound(myArray)
Debug.Print myArray(y)
Next y
With ActiveSheet
For Z = 1 To UBound(myArray)
Cells(Z, 1).Value = myArray(Z)
Next Z
End With
End Sub
I was bored, calmer (so much so!) and with time on my hands to do something useful/productive (which is what I live for, Cant function without trying to do something good at least). So I did something to improve my last code:
Changed the Array , (gosh its so nice to have some time & space without violent music from naighbours to be able to concentrate do something not in a hurry or trauma / anxiety *!) so that it functions properly. Gets the 1st element also (which was missing from the output sheet of the previous code) and also gets the current 'ref value position that the user stopped it for.
Pleased with this too much. ! :) If only I had this level of stress free non-anxiety yesterday. I can see much clearer. !!
Also added a segment in code at the start to un-hide any hidden columns that may be in the workbook sheets (as that is what the bounty winner's answer/tool does as well. The tool may not unhide them, but it can detect them even if they are in hidden columns. One way to do that with VBA is to vba-unhide those columns straight up ).
Sub FindAndExecuteVersion2()
Dim Sh As Worksheet
Dim answer As VbMsgBoxResult
Dim myCell As Range 'this had to be declared to make the activations work (not for the loops ! which uses cell)
Set DataRange = ActiveSheet.UsedRange 'I think you can remove this
Dim myArray() As Variant
Dim x As Long
Set starting_ws = ActiveSheet
For Each Sh In ThisWorkbook.Worksheets
Sh.Activate
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
Next
starting_ws.Activate
refcount = 0
For Each Sh In ThisWorkbook.Worksheets
Dim cell As Range, allCellsInError As Range
Set allCellsInError = Nothing
On Error Resume Next
Set allCellsInError = Sh.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Not allCellsInError Is Nothing Then
For Each cell In allCellsInError
If cell.Text = "#REF!" Then ''only printong the refs (igniring all other errors)
Set myCell = cell 'You need this for real time in the loop activations-selections of said cell
Sh.Activate 'I think you can live without this.
myCell.Select
ReDim Preserve myArray(x)
myArray(x) = Sh.Name & cell.Address
'x = x + 1
refcount = refcount + 1 '' moved it up here 18/08/2020 20:15 (below to get the 1st. start from 0 . proper)
'x = x + 1
'' MsgBox "Ref Found in " & cell.Address & " " & Sh.Name
Debug.Print Sh.Name; cell.Address; cell.Formula
answer = MsgBox("Do you want to go to cell " & Sh.Name & cell.Address & " and fix?", vbYesNo)
If answer = vbYes Then
Sh.Activate
cell.Select
GoTo Line1
Exit Sub
Else
'MsgBox "No"
'GoTo Line1
End If 'must thank also - https://www.automateexcel.com/vba/yes-no-message-box/ - for this
x = x + 1
End If
Next cell
End If
Next
Line1:
'This section outputs the array of found refs upto the point you got to in the message boxes (either the whole thing if you say no to all, or from where you said ok yes deal with) on a sheet after all the other sheets. Basically its a screen dump of the console.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
For y = LBound(myArray) To UBound(myArray)
Debug.Print myArray(y)
Next y
With ActiveSheet
For Z = 1 To UBound(myArray) + 1
Cells(Z, 1).Value = myArray(Z - 1)
Next Z
End With
End Sub
Really pleased with this version. * Maybe that's what liberals seek to do normalise - pass on to and in others.!? Who knows?. It could be the only explanation for the mark down .
This is the way I did it. I wouldn't have got anywhere close to this tonight, if it wasn't for mrfluff at MrExcel.
For references see my question at Mr Excel I posted asking for help re:
looping over columns and rows of any particular sheet on an earlier version of the code I developed, which became "use the usedrange" courtesy of the excellent help I received from the wonderful #mrfluff over there.
Finds all refs and activates each as it goes and gives you the option on each found ref to stop the program and deal with it there and then in that cell. You can restart again after dealing.
Sub FindRefsandErrorsinWorkbookBySheets24()
Dim lastColumn As Integer
Dim myCell As Range
Dim LastRow As Long
Dim myArray() As Variant
Dim x As Long
'Determine the data you want stored
Set DataRange = ActiveSheet.UsedRange
'Resize Array prior to loading data
'nope - ReDim myArray(DataRange.Cells.Count)
refcount = 0
Dim ws As Worksheet
'Dim starting_ws As Worksheet
'Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
For Each ws In ThisWorkbook.Worksheets
ws.Activate
For Each myCell In ws.UsedRange 'ws.UsedRange.SpecialCells(xlFormulas, xlErrors) 'ws.UsedRange
If myCell.Text = "#REF!" Then
refcount = refcount + 1
myCell.Select '' 1. COMMENT OUT FOR SPEED
myCell.Offset(0, 1) = "This was a ref in " & myCell.Address
ReDim Preserve myArray(x)
myArray(x) = myCell.Address
x = x + 1
MsgBox "Ref Found in " & myCell.Address ''2. COMMENT OUT FOR SPEED
If MsgBox("do you want to edit? - press cancel", vbOKCancel) = vbCancel Then Exit Sub ''3. COMMEMT OUT FOR SPEED
ElseIf IsError(myCell.Value) Then
myCell.Offset(0, 1) = "Do you know you had different tyoe of error in " & myCell.Address & "???"
End If
Next myCell
'MsgBox ws.Name
Next ws
MsgBox "Finished Checking. There where " & refcount & "ref errors! and they were in"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
'Range("A1:A" & UBound(myArray)).Value = myArray(x)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
'With sheet
'End With
Next x
With ActiveSheet
For x = 1 To UBound(myArray)
Cells(x, 1).Value = myArray(x)
Next x
End With
''Dim sheet As Worksheet
''Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
'Range("A1:A" & UBound(myArray)).Value = myArray(x)
End Sub
It also finds all and each refs and gives you a list at the end where they are.
I've assumed you want them one by one and you can stop the macro at a particular one to fix it. But if you don't, comment out the entire 3 lines relating to message boxes, where I've written COMMENT OUT THIS ENTIRE LINE IF YOU WANT SPEED . Each one is '1, '2 and '3.
I had them in at the beginning, but once I was assured they worked, I removed them for speed of my testing, before putting them back in just now.
So those 3 sections each having a comment in themselves '1... '2... '3... comment out entirely those 3 lines and you've got a much faster macro with only a final message box with total number of refs, and the output of all the refs in immediate window and a new created sheet at the end.
I prefer the macro without those 3 lines inside, as it runs much more smoothly and quickly. But you were speculating at first if it would be good to edit-investigate the refs as you go/as you find them. So that's why I put them back in just now. But you can remove those 3 lines for a much faster less interrupted sub (& you get the array - total and print out of all the refs locations at the end anyway, so if I were you I'd live without those 3 lines).
Hope I helped. It worked for me. :)
Here is the macro (my preferred one, even if it doesn't show you the refs as it runs or gives you options to stop.) without the message boxes or activates and without the pasting of offsets (which I only had in the 1st because I found them useful on development):
Sub FindRefsandErrorsinWorkbookBySheets245()
Dim lastColumn As Integer
Dim myCell As Range
Dim LastRow As Long
Dim myArray() As Variant
Dim x As Long
'Determine the data you want stored
Set DataRange = ActiveSheet.UsedRange
'Resize Array prior to loading data
'nope - ReDim myArray(DataRange.Cells.Count)
refcount = 0
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
For Each myCell In ws.UsedRange 'ws.UsedRange.SpecialCells(xlFormulas, xlErrors) 'ws.UsedRange
If myCell.Text = "#REF!" Then
refcount = refcount + 1
' myCell.Select '' 1. COMMENT OUT FOR SPEED
' myCell.Offset(0, 1) = "This was a ref in " & myCell.Address
ReDim Preserve myArray(x)
myArray(x) = myCell.Address(, , , 1) '' THIS GETS YOU THE SPECIFICS (SHEET NUMBER TOO)
x = x + 1
' MsgBox "Ref Found in " & myCell.Address ''2. COMMENT OUT FOR SPEED
' If MsgBox("do you want to edit? - press cancel", vbOKCancel) = vbCancel Then Exit Sub ''3. COMMEMT OUT FOR SPEED
' ElseIf IsError(myCell.Value) Then
' myCell.Offset(0, 1) = "Do you know you had different tyoe of error in " & myCell.Address & "???"
End If
Next myCell
Next ws
MsgBox "Finished Checking. There where " & refcount & "ref errors! and they were in"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
Next x
With ActiveSheet
For x = 1 To UBound(myArray)
Cells(x, 1).Value = myArray(x)
Next x
End With
End Sub
They are identical. The only difference is ' lines which changes behaviour.
It just occurred to me (your language phrase: detect them and activate the cells, Where they appear (optionally one by one) Its got me thinking, how would could you have the option to activate cell without knowing where the option is visibaly other than a list given to you or message box (i.e how could you be given option to activate or not without seeing it?)
But strictly going by your words alone, I re-wrote the original macro (which has those unneccissary and potentialy data overwriting offsets) to do that exactly.
The ref is informed to you by a message box, and then a 2nd message box asks if you wish to deal with that Ref (with address) or continue. Yes would select the cell and end the macro/sub. No would just continue.
SO This one is not activating any cell or any worksheet until you decide. You get your messages one by one per ref, and any message box with a particular ref your interested in, is the one you decide to activate-select that ref cell and deal with or not. slightly different. The sheet and cell is only 'activate' (selected) and the program stopped, when you decide based on being told by msgbox (I guess you have a good mental map of where these cells are in your sheets, and you already know which one is more important!?).
With thanks to a go to guy (Jon) at excelcampus and the people at automateexcel here
This one works also. All 3 do, slightly differently, depending on how you read your words.
Sub FindRefsandErrorsinWorkbookBySheets26()
Dim lastColumn As Integer
Dim myCell As Range
Dim LastRow As Long
Dim myArray() As Variant
Dim x As Long
'excel campus - https://www.youtube.com/watch?v=rCh7ki9yVsM
Dim Answer As VbMsgBoxResult
'Determine the data you want stored
Set DataRange = ActiveSheet.UsedRange
'Resize Array prior to loading data
'nope - ReDim myArray(DataRange.Cells.Count)
refcount = 0
Dim ws As Worksheet
'Dim starting_ws As Worksheet
'Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
For Each ws In ThisWorkbook.Worksheets
''' ws.Activate 'you could comment this out too if you dont need or want to see the sheets, and put it back in the "yes portion" of "i wasnt to deal with" - as you kinda implied you want to be chooser of what ref to activate
For Each myCell In ws.UsedRange 'ws.UsedRange.SpecialCells(xlFormulas, xlErrors) 'ws.UsedRange
If myCell.Text = "#REF!" Then
refcount = refcount + 1
'''''myCell.Select '' deleted because your wording kind of suggests you want to choose when to select/activate the cell.
myCell.Offset(0, 1) = "This was a ref in " & myCell.Address
ReDim Preserve myArray(x)
myArray(x) = myCell.Address
x = x + 1
MsgBox "Ref Found in " & myCell.Address ''2. COMMENT OUT FOR SPEED
''''If MsgBox("do you want to edit? - press cancel", vbOKCancel) = vbCancel Then Exit Sub ''3. COMMEMT OUT FOR SPEED
Answer = MsgBox("Do you want to go to cell" & myCell.Address & " and fix?", vbYesNo)
If Answer = vbYes Then
ws.activate
myCell.Select
Exit Sub
Else
'MsgBox "No"
End If 'must thank also - https://www.automateexcel.com/vba/yes-no-message-box/ - for this
ElseIf IsError(myCell.Value) Then
myCell.Offset(0, 1) = "Do you know you had different type of error in " & myCell.Address & "???"
End If
Next myCell
'MsgBox ws.Name
Next ws
If refcount = 0 Then
MsgBox "Finished Checking. There were " & refcount & " Ref Errors!"
Exit Sub
End If
MsgBox "Finished Checking. There where " & refcount & "ref errors! and they were in"
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
'Range("A1:A" & UBound(myArray)).Value = myArray(x)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
'With sheet
'End With
Next x
With ActiveSheet
For x = 1 To UBound(myArray)
Cells(x, 1).Value = myArray(x)
Next x
End With
''Dim sheet As Worksheet
''Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
'Range("A1:A" & UBound(myArray)).Value = myArray(x)
End Sub
Quickest/simplest way imo to handle the last or only potential error in this code and terminate cleanly (that is, if myarray was empty or it found no refs) and account for empty myarray/null array, no ref error situation, was to If refcount = 0 Then otherwise determining if the array was isempty(myarray) = true proved to be a little too difficult extra work & complicated at his time.
I prepared the if statement for checking my cells in the specific row. I have several cells, which I have to check. Their values are mostly "x" but sometimes they vary.
The problem is, that even if one of the value is different than "x", I am still getting the msgbox, that everything is good as per the code, which I prepared.
Sub AuditCheck()
If Range("C33,C39:C40,C43,C53:C54,C57:C59,C68").Value = "x" Or Range("C33,C39:C40,C43,C53:C54,C57:C59,C68").Value = "0" Then
'Rows(39).Delete
Range("C58").Activate 'taking a look just in case
MsgBox ("All good!") ' if so we can hide X
ActiveSheet.Range("$A$5:$IF$77").AutoFilter Field:=1, Criteria1:="<>x", Criteria2:="<>0"
Else
MsgBox ("You have to change the pricing!")
If Range("C39").Value <> "x" Then 'C39 CASE
MsgBox ("Install duct Upturns/upturn section must be removed!")
Call RemoveUpturn
Call New_version_upturn
End If
Exit Sub 'the macro is terminated because you have to change the prices
End If
End Sub
Is there something, which I haven't mentioned in the code?
Try the next code, please:
Sub AuditCheck()
Dim sh As Worksheet, rng As Range, ar As Range, countX As Long, zCount As Long
Set sh = ActiveSheet
Set rng = Range("C33,C39:C40,C43,C53:C54,C57:C59,C68")
For Each ar In rng.Areas
countX = countX + WorksheetFunction.CountIf(ar, "x")
zCount = zCount + WorksheetFunction.CountIf(ar, "0")
Next
If countX = rng.cells.count Or zCount = rng.cells.count Then 'here, you maybe want adding the two counts...
Range("C58").Activate 'taking a look just in case
MsgBox ("All good!") ' if so we can hide X
ActiveSheet.Range("$A$5:$IF$77").AutoFilter field:=1, Criteria1:="<>x", Criteria2:="<>0"
Else
MsgBox ("You have to change the pricing!")
If Range("C39").Value <> "x" Then 'C39 CASE
MsgBox ("Install duct Upturns/upturn section must be removed!")
Call RemoveUpturn
Call New_version_upturn
End If
End If
End Sub
It looks strange checking of counted "x" or "0". If you wanted to count them together, you should add them an compare with total range cells count...
If counting zero does not count (anymore), you just delete the second condition.
You must use CountIf (doc here) which will counts the number of cells within a range that meets the given criteria to do that you would have done something like that :
Sub Try_Me()
Dim Myrng As Range
Dim NumCheck as Long
Dim StrCheck as String
StrCheck = "x"
NumCheck = 0
Set Myrng = Range("C33,C39:C40,C43,C53:C54,C57:C59,C68")
If WorksheetFunction.CountIf(Myrng, NumCheck ) = Myrng.Count Or WorksheetFunction.CountIf(Myrng, StrCheck ) = Myrng.Count Then
Range("C58").Activate 'taking a look just in case
MsgBox ("All good!") ' if so we can hide X
ActiveSheet.Range("$A$5:$IF$77").AutoFilter Field:=1, Criteria1:="<>x", Criteria2:="<>0"
Else
MsgBox ("You have to change the pricing!")
If Range("C39").Value <> "x" Then 'C39 CASE
MsgBox ("Install duct Upturns/upturn section must be removed!")
Call RemoveUpturn
Call New_version_upturn
End If
Exit Sub 'the macro is terminated because you have to change the prices
End If
End Sub
EDIT According to #chris neilsen you should do as below since CountIf does not work with non-contiguous range.
So I would suggest you to just count the number of X in your range if it does match with the excepted number of x or 0 the the if condition will return true :
Sub Try_Me()
Dim Myrng As Range
Dim NumCheck as Long
Dim StrCheck as String
Dim NumExceptedX as Int
Dim NumeExceptedZ
NumExceptedX = 11
NumeExceptedZ = 15
StrCheck = "x"
NumCheck = 0
Set Myrng = Range("C33:C68")
If WorksheetFunction.CountIf(Myrng, NumCheck ) = NumeExceptedZ Or WorksheetFunction.CountIf(Myrng, StrCheck ) = NumExceptedX Then
Range("C58").Activate 'taking a look just in case
MsgBox ("All good!") ' if so we can hide X
ActiveSheet.Range("$A$5:$IF$77").AutoFilter Field:=1, Criteria1:="<>x", Criteria2:="<>0"
Else
MsgBox ("You have to change the pricing!")
If Range("C39").Value <> "x" Then 'C39 CASE
MsgBox ("Install duct Upturns/upturn section must be removed!")
Call RemoveUpturn
Call New_version_upturn
End If
Exit Sub 'the macro is terminated because you have to change the prices
End If
End Sub
This is probably super simple but If I already have a selection how can I add the next row without know necessarily what the next one is?
EDIT
For example if I have the input range "D1:D8" how can I add in the next row, ie "D1:D9" without putting in "D1:D9".
Try
Sub inc_row()
Selection.Resize(Selection.Rows.Count + 1, Selection.Columns.Count).Select
End Sub
This will increase your selection by 1 row, it will also select the new range
Sub test()
Dim rng As Range
Set rng = Range("b2:f5")
Debug.Print rng.Address 'returns $B$2:$F$5
Set rng = rng.Resize(rng.Rows.Count + 1)
Debug.Print rng.Address 'returns $B$2:$F$6
End Sub
Sub RunCompare()
Call compareSheets("Latest", "SFDC")
End Sub
Sub compareSheets(shtLatest As String, shtSFDC As String)
Dim mycell As Range
Dim mydiffs As Integer
'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(shtSFDC).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtLatest).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
End If
Next
'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(SFDC).Select
End Sub
Sub RunCompare()
compareSheets "Latest", "SFDC"
End Sub
'Compares two sheets and colours yellow any cell in sheet2 that is not the same as in sheet 1
Sub compareSheets(sheet1 As String, sheet2 As String)
Dim rCell1 As Range
Dim rCell2 As Range
Dim nDiffs As Long ' Using a long because Integer may one day be too small
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ActiveWorkbook.Worksheets(sheet1)
Set ws2 = ActiveWorkbook.Worksheets(sheet2)
For Each rCell1 In ws1.UsedRange.Cells
Set rCell2 = ws2.Range(rCell1.Address)
If rCell1.Value <> rCell2.Value Then
rCell2.Interior.Color = vbYellow
nDiffs = nDiffs + 1
End If
Next rCell1
Debug.Print nDiffs
End Sub
This should help you produce a workable solution. In your code, the 'For Each mycell' line creates a loop on each 'Range' object in 'UsedRange' not on each individual cell.
Your 'Subscript out of range' may become from invalid sheet names.
Are you sure that active book when you call macro is one with Latest and SFDC worksheets.
Not directly related to problem, but I would suggest you to change your function prototype to
Sub compareSheets(ByVal shtLatest As Worksheet, ByVal shtSFDC As Worksheet)
replace all ActiveWorkbook.Worksheets(shtSFDC) with shtSFDC (same for shtLatest) and finally replace call with
Call compareSheets(ActiveWorkbook.Worksheets("Latest"), ActiveWorkbook.Worksheets("SFDC"))
or directly with code name:
Call compareSheets(sheet1, sheet2)
That is clearer as compareSheets expects sheets, not text.