I'm trying to fill empty cells in a specified range. I have used code taken from other questions to write this:
Dim rCell As Range
For Each rCell In ws.Range("E36:G45")
If IsEmpty(rCell.Value) = True Or IsNull(rCell.Value) = True Or rCell.Value = "" Then
rCell.Value = -999
End If
Next rCell
This doesn't work, neither does the following (where the Boolean is removed):
For Each rCell In ws.Range("E36:G45")
If IsEmpty(rCell.Value) Or IsNull(rCell.Value) Or rCell.Value = "" Then
rCell.Value = -999
End If
Next rCell
The range E36:G45 contains a mix of empty and non-empty cells.
I have tried clearing the contents.
There are no sub procedures that could make the cells un-editable.
My guess is that the code is looking at a different worksheet - I suspect it's writing those -999s elsewhere.
If I were doing this, I'd use the following code:
Sub Fill_empty_cells()
On Error Resume Next
ws.Range("E36:G45").SpecialCells(xlCellTypeBlanks).Value = -999
On Error GoTo 0
End Sub
This definitely fills in cells that have been cleared using ClearContents.
That said, your original code does that also, hence my theory it's not looking at the same sheet you are.
To fully debug what's going on though, why not create some commentary so you read what's going on:
Sub test()
Dim rCell As Range
Set ws = ActiveSheet
For Each rCell In ws.Range("E36:G45")
If IsEmpty(rCell.Value) = True Or IsNull(rCell.Value) = True Or rCell.Value = "" Then
rCell.Value = -999
Else
Debug.Print "Not filling cell " & rCell.Address & " of sheet [" & rCell.Parent.Name & "] because it contains """ & rCell.Value & """"
End If
Next rCell
End Sub
Try simplifying your criteria; you can use len() combined with trim() to help with this, which will give your results as either 0 or >0:
dim cellRef as range
for each cellRef in ws.range("E36:G45")
Select case len(trim(cellRef.value))
Case 0
cellRef.value = -999
End select
Next cellRef
Edit1: Updated per Ben's comment;
Related
Hello Trying to write a simple program That I can share with my team.
I want to be able to have a shared excel document that contains a list of available part numbers.
When you click a button It grabs and prints a part number from the list, then marks it used, and never issues that part# again.
layout picture
"Sheet1" contains the Part #s and usage info.
Column A: Part#'s, Column B: Either 0 (available), 1(used)
"Sheet2" where the user obtains a part number.
A1 = part# ouput (user copys this)
Here's the code I tried, but I'm quite a novice and not really sure how to make this work... Appreciate your help.
Sub GenNumber()
Dim PartNum As String
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("B1:B1000000")
For Each rCell In rRng.Cells
If rCell = 0 Then
Set rCell.Value = 1
PartNum = rCell.Offset(0, -1)
Range("A1") = PartNum
Exit For
Else
End If
Next
MsgBox "Part-Number Issued: " + PartNum
End Sub
It didn't run without these changes - does this help?
Sub GenNumber()
Dim PartNum As String
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("B1:B1000")
For Each rCell In rRng.Cells
If rCell.Value = 0 Then
rCell.Value = 1
PartNum = rCell.Offset(0, -1)
Range("A1") = PartNum
Exit For
Else
End If
Next
MsgBox "Part-Number Issued: " + PartNum
End Sub
I have code which looks through an Excel table.
Sub ErrorCheck()
Dim ErrColl As New Collection
Dim NameColl As New Collection
Worksheets(WorksheetName).Select
Worksheets(WorksheetName).Range("B5").Select
Do Until IsEmpty(ActiveCell)
On Error Goto eh
NameColl.Add ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Loop
eh:
ErrColl.Add ActiveCell.Value
End Sub
The above will stop once a duplicate occurs. I don't want the code to stop when a duplicate occurs, because I need all the duplicates to be shown in msgbox/logged onto a file. 'Resume next' will give me the right answer with no duplicates, but will not show the where the duplicates are. 'GoTo' will only show the first error. Is there another way to do this?
You can always combine ´On Error Resume Next´ with a check of the Error code. The following (very silly) code should illustrate how this works:
On Error Resume Next
Dim i As Integer
Dim m As Integer
Dim n As Double
For i = 1 To 10
m = i Mod 3
n = i / m
If Err.Number > 0 Then
MsgBox ("Handle error here")
Err.Number = 0
Else
MsgBox ("n: " + Str(n))
End If
Next
What this is doing is to test for the Error code on the line after the error is likely to occur. If there was no error (Err.Number = 0), the code continues with the Else. If an error has been raised (in this case Err.Number = 11 - division by zero when i is 3, 6 and 9), then you can handle the error within the If and the code continues after the End If. Notice that you need to reset the Err.Number back to 0!
I wouldn't select stuff so much because it will slow your code down.
Anyway, here's something that might be of use. Change the code where necessary.
Sub ErrorCheck()
Dim rCell As Range
Dim lRow As Long
Dim rCheck
With Worksheets(1) 'change to suit
Set rCell = .Cells(5, 2)
Set rCheck = rCell
lRow = 1
Do Until rCell(lRow).Value = vbNullString
Set rCheck = Union(rCheck, rCell.Offset(lRow))
With rCell.Offset(lRow)
If WorksheetFunction.CountIf(rCheck, .Value) > 1 Then
Debug.Print .Address & vbTab & .Value 'using the Immediate Window as an example
End If
End With
lRow = lRow + 1
Loop
End With
Set rCell = Nothing
Set rCheck = Nothing
End Sub
I am trying to run through some spreadsheet range and use a try/except in order to build an if/else statement. The reason I am doing this is because IsNumeric() is not working for me so I am trying to do something like this (try except formatting from python)
Dim Temp as Integer
Dim Myrange as Range
Dim Myrow as Range
Set Myrange = Range("A1","A1000")
For Each Myrow in Myrange.Row
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For 'To escape the loop at the end of the filled cells
Else
Try:
Temp = (Myrow.Value() - 0) 'This causes a #VALUE! error when the Myrow.Value is not a number.
Except:
Range("B" & Myrow.Row).Value = Temp 'this sets the value of the rightmost cell to whatever current value of Temp is.
I have also tried some other error catching but can't seem to get it in VBA.
For Each Myrow In Myrange.Rows
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For
Else
On Error Resume Next
Temp = Myrow.Value() - 0
If Err.Number = 0 Then
Range("A" & Myrow.Row).Value = ""
ElseIf Err.Number <> 0 Then
Range("B" & Myrow.Row) = Temp
End If
End If
Next Myrow
I am really just looking to run down the list, see the first number, set value of B0:Bn1 = Temp, when An is hit (new number), The value of Temp changes to temp2 and then cells Bn1+1 -> Bn2-1 is temp2 until a new number is found etc.
in the worksheet I can do it fine with dragging down formula =(A1-0) to see the error message for those that are not numeric but for some reason I can't code it.
Solved this using advice of #MathieuGuindon by using variant type and testing isnumeric on that. Solution code:
Dim Myrange As Range
Dim Myrow As Range
Dim Temp As Variant
Dim NextTemp As Variant
Set Myrange = Selection
For Each Myrow In Myrange.Rows
NextTemp = Range("A" & Myrow.Row).Value
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For
ElseIf IsNumeric(NextTemp) Then
Temp = NextTemp
Range("A" & Myrow.Row).Value = ""
Else
Range("B" & Myrow.Row).Value = Temp
End If
Next Myrow
A bit of simplification, and picking up on Mathieu's comments, try this. Not sure what you're doing though so may no be quite right.
Sub x()
Dim Temp As Variant
Dim Myrange As Range
Dim Myrow As Range
Set Myrange = Range("A1", "A1000")
For Each Myrow In Myrange
If Not IsEmpty(Myrow) Then
Temp = Myrow.Value - 0
If IsNumeric(Temp) Then
Myrow.Value = vbNullString
Else
Myrow.Offset(, 1).Value = Temp
End If
End If
Next Myrow
End Sub
One way is to have a dedicated error handler at the end of your sub, and check the error code (13 for Type Mismatch):
Option Explicit
Public Sub EnumerateValues()
On Error GoTo err_handle
Dim Temp As Integer
Dim Myrange As Range
Dim Myrow As Range
Dim myNumber As Double ' Int? Long?
Set Myrange = Range("A1", "A1000")
For Each Myrow In Myrange.Rows
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For ' to escape loop at end of filled cells
Else
myNumber = CDbl(Myrow.Value())
Debug.Print myNumber
End If
' use label, since VBA doesn't support Continue in loop.
loop_continue:
Next Myrow
exit_me:
Exit Sub
err_handle:
Select Case Err.Number
Case 13 ' Type Mismatch
GoTo loop_continue
Case Else
MsgBox Err.Description, vbOKOnly + vbCritical, Err.Number
GoTo exit_me
End Select
End Sub
This way, if we encounter a value for which CDbl (or the equivalent function) fails, we just continue on to the next row.
While the first example contains Try: and Except: as labels, they provide no error control. Try/Except are vb.net error control methods, not vba.
It's unclear whether you might have text that looks like numbers in column A. If the Temp = (Myrow.Value() - 0) is only meant to determine whether the value in column A is a number and not used as a conversion then SpecialCells can quickly find the numbers in column A.
dim rng as range
on error resume next
'locate typed numbers in column A
set rng = Range("A:A").SpecialCells(xlCellTypeConstants, xlNumbers)
on error goto 0
If not rng is nothing then
rng = vbNullString
End If
on error resume next
'locate text values in column A
set rng = Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
on error goto 0
If not rng is nothing then
rng.Offset(0, 1) = rng.Value
End If
You can also use xlCellTypeFormulas to return numbers or text returned by formulas.
so i have this code and what i want to do is the following:
if Range("aj61:aj432") is blank and Range("F61:F432") has text, then set the blank cells to 0
Here is what I tried but got a type mismatch
Sub Insert_0()
Dim rng As Range
Set rng = Range("AJ61:AJ432")
If IsEmpty(rng) And rng.Offset(-30, 0) <> "" Then rng.Value = 0
End Sub
Use SpecialCells to capture the rows from text values in column F intersecting with the blank values in column AJ.
Option Explicit
Sub Insert_0()
Dim rng As Range
On Error Resume Next
Set rng = Intersect(Range("F61:F432").SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow, _
Range("AJ61:AJ432").SpecialCells(xlCellTypeBlanks))
On Error GoTo 0
If Not rng Is Nothing Then
rng = 0
Else
Debug.Print Err.Number & ": " & Err.Description
On Error GoTo -1
End If
End Sub
You need to loop through range:
For i = 61 To 432
If Cells("AJ" & i).Value = "" And Cells("F" & i).Value <> "" Then Cells("AJ" & i).Value = 0
Next
no loops
Sub Insert_0()
Intersect(Range("F61:F432").SpecialCells(xlCellTypeConstants).EntireRow, Range("AJ:AJ")).SpecialCells(xlCellTypeBlanks).Value = 0
End Sub
If you want to check if a range of multiple cells is blank, you need to use something like:
If WorksheetFunction.CountA(rng) = 0 Then
You would have to loop through the cells in the range. Something like:
dim cel as range
for each cel in rng.cells
If IsEmpty(cel) And cel.Offset(-30, 0) <> "" Then cel.Value = 0
next
to make it faster you could fill an array with the values of the range
I work with Ranges and sometimes all cells in a given object are deleted (Range.Cells.Delete)
I've played around and find these:
after deleting all cells, type of the variable is still Range and it Is Not Nothing
calling any of it's members results in Error "Object required"
Here is my small sub to test it:
Sub test()
Dim r As Range
Debug.Print r Is Nothing ' -> true
Set r = ActiveSheet.Range("a2")
Debug.Print TypeName(r) ' -> Range
r.Cells.Delete shift:=xlShiftUp
On Error GoTo ErrHandler
Debug.Print r Is Nothing ' -> False
Debug.Print TypeName(r) ' -> Range
Debug.Print r.Address ' -> "Err: Object required"
Debug.Print r.Cells.Count ' -> "Err: Object required"
Exit Sub
ErrHandler:
MsgBox "Err: " & Err.Description
Resume Next
End Sub
My question is: how can I determine (hopefully without error handling) whether an object is an empty Range?
Shortest option I've found so far:
Function IsEmptyRange(testRange As Range) As Boolean
If TypeName(testRange) <> "Range" Then
IsEmptyRange = False
Else
On Error GoTo EmptyRange
IsEmptyRange = testRange.Cells.Count = 0
If False Then
EmptyRange:
Err.Clear
IsEmptyRange = True
End If
End If
End Function
There's an interesting discussion about this on Daily Dose of Excel pointing to a similar Stack Overflow question. The DDoE doesn't give a 'solution' but the discussion is illuminating regarding 'expected behaviour'. The SO post does (by #DougGlancy) but it is just a version of your code (perhaps slightly better because no If False Then... construct required).
IMO the best practice here is to remember to set your reference variables to Nothing if, and when, you can. E.g.
Sub test()
Dim r As Range
Debug.Print r Is Nothing ' -> true
Set r = ActiveSheet.Range("a2")
Debug.Print TypeName(r) ' -> Range
r.Cells.Delete shift:=xlShiftUp
Set r = Nothing ' -> end of problem
On Error GoTo ErrHandler
Debug.Print r Is Nothing ' -> True
If Not r Is Nothing Then
Debug.Print TypeName(r) ' -> Range
Debug.Print r.Address ' -> "Err: Object required"
Debug.Print r.Cells.Count ' -> "Err: Object required"
End If
Exit Sub
ErrHandler:
MsgBox "Err: " & Err.Description
Resume Next
End Sub
The tendency is probably to let scope deal with the clean-up (i.e. r will go out of scope once the Sub is complete) but it is better to do the clean-up yourself.
In my case I don't have any loop, therefore For ... Step -1, as Nigel Heffernan says, is not a solution.
With this problem the correct solution will depend on the context.
This is mine:
Sub test()
'Mi context: from C2 all the cells are empty
Dim Rng As Range
Set Rng = ActiveSheet.Range("A2:B2")
'trim all cells in Rng
Rng = Application.Trim(Rng.Value)
'I use CountIf instead xlCellTypeBlanks because it
'would give an error if there are no empty cells
If WorksheetFunction.CountIf(Rng, "") > 0 Then
'delete all empty cells in Rng
Rng.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End If
'Assign Rng again
Set Rng = ActiveSheet.Range("A2:B2")
'and check again if all cells are empty
If WorksheetFunction.CountIf(Rng, "") = Rng.Cells.Count Then
MsgBox """A2:B2"" range have been deleted"
Else
'do something
End If
End Sub
In other contexts you can store the initial values of Rng and, after deleting cells in the range, compare with the newly assigned Rng