I want to check if a selection from a user has a blank cell in a column of that selection. The iteration is tricky for me using a selection as opposed to a preset range.
Any help on how to set the range properly would be most appreciated.
Dim cutrng As Range
Dim c As Range, t As Range
Set cutrng = Selection.EntireRow
For Each t In cutrng.Cells
For Each c In t.Cells
If IsEmpty(Cells(c, 53).Value) = True Then
MsgBox ("You have selected lines that do not have data.")
End
Else
End If
Next c
Next t
Try the following
Set myRow = Selection.Row
If IsEmpty(Cells(myRow, 53)) = True Then
MsgBox ("You have selected lines that do not have data.")
End If
There is no need to loop if you only want to check the cell in column 53 and you only have one cell selected. If you expect the user to select multiple rows then try:
Dim myRow as Range
For each myRow in Selection.Rows
If IsEmpty(Cells(myRow, 53)) = True Then
MsgBox ("You have selected lines that do not have data.")
End If
Next myRow
Ended up figuring it out. Thanks everyone for your help.
Dim cutrng As Range
Dim g As Long
Set cutrng = Selection.EntireRow
For g = 1 To Selection.Rows.count
If IsEmpty(cutrng.Cells(g, 53)) = True Then
MsgBox ("You have selected lines that do not have data.")
End
Else
End If
Next g
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.
If the users fill in the serial no. column in col B (it doesn't have to be all 10 of them, as long as one is filled), they need to fill up the other columns from col C to col F. Hence, if col B is filled up but any of the cells in col C to F are not filled up, I want an error message to pop up. I hope the image below gives a clearer idea..:
I'm not sure if Worksheet_SelectionChange will do what I want to accomplish...because I don't want to include a command button. As some users may not bother clicking on the command button to verify their inputs. This is the code I have at the moment, please feel free to advise accordingly....thank you:)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B4").Value = "" Then
MsgBox "serial no. is a Mandatory field", vbExclamation, "Required Entry"
Range("B4").Select
End If
If Range("B4:B") <> "" Then
If Range("C4:C").Value = "" Then
MsgBox "Product is a Mandatory field", vbExclamation, "Required Entry"
Range("C4:C").Select
End If
' Adding values from sheet 2 for fruits drop-down list.
If Not Intersect(Target, Range("D3")) Is Nothing Then
Sheets("Sheet1").Range("D3") = "[Please Select]"
Dim col As New Collection
Dim rng As Range
Dim i As Long
Dim dvlist As String
'Loop thru the data range
For Each rng In Sheet2.Range("B2:B7")
'ignore blanks
If Len(Trim(rng.Value)) <> 0 Then
'create a unique list
On Error Resume Next
col.Add rng.Value, CStr(rng.Value)
On Error GoTo 0
End If
Next rng
'concatenate with "," as the delimiter
For i = 2 To col.Count
dvlist = dvlist & col.Item(i) & ","
Next i
With Sheet1.Range("C2:C").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=dvlist
End With
End If
' Adding values from sheet 2 for country of origin drop-down list.
If Not Intersect(Target, Range("E4")) Is Nothing Then
Sheets("Screening Request").Range("E4") = "[Please Select]"
'Loop thru the data range
For Each rng In Sheet2.Range("A2:A7")
'ignore blanks
If Len(Trim(rng.Value)) <> 0 Then
'create a unique list
On Error Resume Next
col.Add rng.Value, CStr(rng.Value)
On Error GoTo 0
End If
Next rng
'concatenate with "," as the delimiter for list in Sheet 2
For i = 2 To col.Count
dvlist1 = dvlist1 & col.Item(i) & ","
Next i
'add it to the DV
With Sheet1.Range("D3").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=dvlist1
End With
End If
' This is for the date (YYYYMMDD) column. I need it to be in YYYYMMDD format:
If Not Intersect(Target, Range("F4:F13")) Is Nothing Then
If Not IsNumeric(.Value) And Not cel.NumberFormat = "yyyymmdd" Then
MsgBox "Date format must be in YYYYMMDD"
cel.Value = ""
Exit Sub
Else: cel.NumberFormat = "yyyymmdd"
End If
End With
End If
In general, you are making life much too hard for yourself. Use the tools that Excel provides (and there are many); you do not need to re-invent the wheel.
For example the lists for fruits and country of origin in your Sheet2 should be used as a list for data validation purposes in Sheet1 (Data Tab, Data Tools, Data Validation). Choose Allow List, make sure Ignore blank and In-cell dropdown are checked and select the range from Sheet2.
Similarly you can use data validation to validate dates in your last column.
You now do not need to validate these columns yourself, as they will always have blanks or valid values.
Combine this with my suggestion of conditional formatting (eg for the range c4:c13 you should enter =AND(B4<>"",ISBLANK(C4)) and for all three columns, you can produce a very simple verification routine. Something like:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = MissingEntries()
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = MissingEntries()
End Sub
Private Function MissingEntries() As Boolean
Dim i As Integer
Dim j As Integer
Dim atLeastOneLine As Boolean
atLeastOneLine = False
For i = 4 To 13
If (Cells(i, 2) <> "") Then
atLeastOneLine = True
For j = 3 To 6
If Cells(i, j) = "" Then
MsgBox ("Please supply values for highlighted cells")
MissingEntries = True
Exit Function
End If
Next
If WrongSerialNumber(i) Then
MissingEntries = True
Exit Function
End If
End If
Next
If Not atLeastOneLine Then
MsgBox ("Please supply values for at least one line")
MissingEntries = True
Else
MissingEntries = False
End If
End Function
Private Function WrongSerialNumber(i As Integer) As Boolean
Dim yr As Integer
Dim serialNo As String
Dim yrStr As String
Dim yrCell As String
serialNo = Cells(i, 2)
If Len(serialNo) < 3 Then
WrongSerialNumber = True
MsgBox "Serial Number for row no. " + CStr(i - 3) + " is too short. Please correct."
Exit Function
End If
yrCell = Cells(i, 6)
If Len(yrCell) = 8 Then
yr = CInt(Left(Cells(i, 6), 4))
If yr > 1968 Then
If Mid(yrCell, 3, 2) <> Mid(serialNo, 2, 2) Then
WrongSerialNumber = True
MsgBox "Serial Number for row no. " + CStr(i - 3) + " has wrong second and third digits. These should match the third and fourth digits of the date. Please correct."
Exit Function
End If
End If
End If
WrongSerialNumber = False
End Function
Note that I validate on both close and save. The former is optional.
Because of the highlighting, a simple message suffices, you are spared the work of informing the user, which cells are missing. In this way the combination of in-built Data Validation and Conditional Formatting makes the remainder of your task so much easier.
I want to use if-then statement across two workbooks.
I've defined x as Long but x does not appear to hold the value of the sum of all cells in column B
But the code looks right, any thoughts?
Sub mycode()
Dim x As Long
myRange = Workbooks("Book2").Sheets("Sheet1").Range("B1", _
Range("B1").End(xlDown))
x = WorksheetFunction.Sum(myRange) '<<does not seem to hold value
If Workbooks("Book1").Sheets("Sheet1").Range("A1").Value = x Then
MsgBox ("values equal")
Else
MsgBox ("please review values")
End If
End Sub
As an example:
Sub MyCode()
Dim myRange As Range
Set myRange = Workbooks("Book2").Sheets("Sheet1").Columns(2)
If Workbooks("Book1").Sheets("Sheet1").Range("A1").Value = WorksheetFunction.Sum(myRange) Then
MsgBox "Values equal"
Else
MsgBox "Please review values"
End If
End Sub
I want to create a macro to compare two versions of a report in order to check if historical data is changed when creating the new report.
I want to loop through the Used Range of one sheet and then compare each cell in that range with the same address in another sheet.
This is the code so far:
Sub Compare_Report()
Dim vRange As Range
Dim v_Rangeversie As Range
On Error GoTo ErrorCatch
Debug.Print Now
Set v_Rangeversie = Worksheets("VorigeVersie").UsedRange
For Each v_range In Worksheets("1. Overzicht").UsedRange
For Each vCell In v_range
Debug.Print vCell.Address
'If vCell.Value != v_Rangeversie.Range.Cell(vCell.address)
'Then
' Debug.Print "Ongelijk"
' Cells are different.
' varSheetB.Cell.Interior.ColorIndex = 3
' varSheetB.Cell.Font.Color = 2
'End If
Next
Next
Exit Sub
ErrorCatch:
MsgBox Err.Description
End Sub
I can't get this If-statement to work:
'If vCell.Value != v_Rangeversie.Range.Cell(vCell.address)
What do I miss? Please help.
Regards, Jan
What about something like this:
Sub compareSheets(shtBefore As String, shtAfter As String)
'Retrieved from MrExcel.Com July 2012
Dim mycell As Range
Dim mydiffs As Integer
For Each mycell In ActiveWorkbook.Worksheets(shtAfter).UsedRange
If Not mycell.Value = _
ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.Row, mycell.Column).Value Then
'Or use "mycell.Value <> othercell.Value"
mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
End If
Next
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtAfter).Select
End Sub
It highlights the differences in yellow.
For using it you should call it within another sub like this:
Sub highlight_differences()
Call compareSheets("1. Overzicht", "VorigeVersie")
End Sub
The conditional formatting alternative. You may want to write it in VBA in order to call it after generating the report... It's a one-liner:
Worksheets("1. Overzicht").UsedRange.FormatConditions.Add _
(xlExpression, , "=A1<>VorigeVersie!A1").Interior.ColorIndex = 3