VBA Return message if cell(s) in range are blank - vba

i am trying to return a message if any cells in a given range are blank. If i declare the range i.e.
Set OrderRng = [C1: C41]
it works fine, but if i declare it as such;
Set OrderRng = Range("c1:" & ActiveSheet.Range("c65536"). End(xlUp).Address).Select`
It does not work.
I know the second argument range is declared correctly as it always highlights the correct cells.
My entire code looks like this;
> Sub BlankCell() Dim OrderRng As Range On Error Resume Next
>
> Set OrderRng = Range("c1:" & ActiveSheet.Range("c65536").End(xlUp).Address).Select
>
> ' Set OrderRng = [C1: C41] ' Rm'd for testing
>
> Set OrderRng = OrderRng.SpecialCells(xlCellTypeBlanks)
>
> If Err = 0 Then MsgBox "An Order ID is missing on one of your entries,
> please amend then try again" End If End Sub
What am i doing wrong, i know it will be obvious, but not to me.
Many thanks

To fix, just remove the .select from the end of your range variable set line:
Set OrderRng = Range("c1:" & ActiveSheet.Range("c65536").End(xlUp).Address)
The .select method returns a TRUE or FALSE value, so you end up with a type mismatch trying to Set OrderRng to TRUE, which is a boolean, not a range.
Also there's 100% no reason to select here and your code should continue on fine.

Related

Formatting issue while exporting data to Excel using VBA macro

I am using below VBS code to export one chart (from QlikView) to excel.
Reason I am using Number format = ‘#’ and paste special because if I do not use it then values in the chart like ‘22001E-07’ gets converted to 2.20E-03
sub GPOTest1
set oXL=CreateObject("Excel.Application")
oXL.visible=True
oXL.Workbooks.Add
aSheetObj=Array("CH01")
for i=0 to UBound(aSheetObj)
oXL.Sheets.Add
Set oSH = oXL.ActiveSheet
oSH.Range("A1").Select
Set obj = ActiveDocument.GetSheetObject(aSheetObj(i))
obj.CopyTableToClipboard True
oSH.Columns("B").NumberFormat = "#" ‘In “B” column I get values like 22001E-07
oSH.PasteSpecial -4163
sCaption=obj.GetCaption.Name.v
set obj=Nothing
oSH.Rows("1:1").Select
oXL.Selection.Font.Bold = True
oSH.Cells.Select
oXL.Selection.Columns.AutoFit
oSH.Range("A1").Select
oSH.Name=left(sCaption,30)
set oSH=Nothing
next
set oXL=Nothing
end sub
After running it for the first time, from 2nd time I get message
PasteSpecial method of Worksheet class failed
Referred following link, however, issue persists:
use macro to convert number format to text in Excel
You shouldn't systematically create an Excel instance. Your code leaves Excel open. Once Excel is open, the next time around, you can get a reference to it using GetObject. See the approach taken in the code below, where I've also simplified a couple things:
Sub GPOTest1()
On Error Resume Next
Set oXL = CreateObject("Excel.Application")
If oXL Is Nothing Then
Set oXL = GetObject(Class:="Excel.Application")
End If
On Error GoTo 0
oXL.Visible = True
Set oWB = oXL.Workbooks.Add
aSheetObj = Array("CH01")
For i = 0 To UBound(aSheetObj)
Set oSH = oWB.Sheets.Add
Set obj = ActiveDocument.GetSheetObject(aSheetObj(i))
obj.CopyTableToClipboard True
oSH.Columns("B").NumberFormat = "#" 'In “B” column I get values like 22001E-07
oSH.PasteSpecial -4163
oSH.Rows("1:1").Font.Bold = True
oSH.Columns.AutoFit
oSH.Range("A1").Select
oSH.Name = Left(obj.GetCaption.Name.v, 30)
Set oSH = Nothing
Set obj = Nothing
Next
Set oXL = Nothing
End Sub

Error 1004: Unable to Get CountIf Property

I'm trying to search a range of named cells to see if there are any cells that contain a number greater than zero. Here is the code I currently have:
Dim YTDclauses As Boolean
Dim ytdrng As Range
Set ytdrng = Worksheets("Sheet1").Range("z1AY:z1BB,z1BG:z1BJ")
'Employer 1
If Sheet1.[z1AG] = "No" And WorksheetFunction.CountIf(ytdrng, ">0") = 0 Then
MsgBox "Works!"
Else
MsgBox "Does Not Work"
End If
I'm getting an error back as "Run-time error '1004': Unable to get the CountIfs property of the WorksheetFunction class". By looking at other questions, I think it might be a syntax error with how I'm setting ytdrng, but I've tried many ways of naming it differently to no avail. Any help is appreciated, thank you!
Note: Sheet1 is named "Main Checklist" - I also tried using that in the setting of ytdrng, but got the same error.
As #ScottCraner has stated, you cannot do a countif on a split range. You can modify the routine slightly to implement a countif by looping over each cell in the range:
Dim YTDclauses As Boolean
Dim ytdrng As Range
Dim SRCountif As Long
Dim cel As Object
Set ytdrng = Worksheets("Sheet1").Range("z1AY:z1BB,z1BG:z1BJ")
SRCountif = 0
For Each cel In ytdrng.Cells
If cel.Value > 0 Then SRCountif = SRCountif + 1
Next
'Employer 1
If Sheet1.[z1AG] = "No" And SRCountif = 0 Then
MsgBox "Works!"
Else
MsgBox "Does Not Work"
End If
(The variable SRCountif is meant to mean SplitRangeCountif)
Note that as it is comparing the value to numeric 0, Exec takes any text as greater than 0, so you may want to adjust the test if there is a chance of any text in your range.

Edge cases in IsNumeric- is this overthinking it

I have code which looks like this:
Select Case IsNumeric(somevariable)
Case True
Resume Next
Case False
Call notnum
Else
Call MyErrorHandler
End Select
Is this overthinking it? Is there a chance IsNumeric will return something other than True or False here or is this bad programming practice?
Don't need the else as it will be true or false however, just a note the Else should be Case Else (moot point though as you are about to delete it)
Based on this though I wouldn't use a case for only 2 options:
If IsNumeric(somevariable) then
Resume Next
Else
Call MyErrorHandler
End if
Edit: Here is how error checking works:
Sub SheetError()
Dim MySheet As String
On Error GoTo ErrorCheck
MySheet = ActiveSheet.name
Sheets.Add
ActiveSheet.name = MySheet
MsgBox "I continued the code"
ActiveSheet.name = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
MsgBox "I will never get to here in the code"
End
ErrorCheck:
If Err.Description = "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic." Then
Resume Next
Else
MsgBox "Error I am not designed to deal with"
End If
End Sub
Copy and paste this module to your personal workbook or to a new workbook and run it, step through line by line using F8 to see how it is actually dealing with the error.
From OP's comment I'm not using my error handler. I want to do stuff with the hopefully numeric output
Sub demo()
Dim inputs As Variant
inputs = InputBox("Prompt", "Title", "Default")
If Not IsNumeric(inputs) Then
notnum
Else
' Do what you want with numeric input inside the Else
End If
' Maybe do more stuff irrespective of input
End Sub
Sub notnum()
' do not numeric stuff here
End Sub
Or if you want to keep prompting for numeric input until the users gets it right or cancels
Sub demo2()
Dim inputs As Variant
Do
inputs = InputBox("Enter something Numeric", "Title", "Default")
Loop Until IsNumeric(inputs) Or inputs = vbNullString
If Not inputs = vbNullString Then
' Do wht you want with numeric input inside the Else
End If
' Maybe do more stuff irrespective of input
End Sub
Input box can have different type of input validation. Try this
something = Application.InputBox("Pls Insert the Number", Type:=1)
If something = False Then Exit Sub
'Type:=0 A formula
'Type:=1 A number
'Type:=2 Text (a string)
'Type:=4 A logical value (True or False)
'Type:=8 A cell reference, as a Range object
'Type:=16 An error value, such as #N/A
'Type:=64 An array of values

Assignment to constant not allowed

I am getting this error in one of my macros, the code is
Dim rdel1 As Range
Dim rdel2 As Range
Set rdel1 = Sheets("Sheet1").Range(A1:B100)
For Each rdel2 In rdel1.Cells
If rdel2.Value = "No item selected" Then
rdel2.Offset(1, 0).EntireRow.Delete
rdel2.EntireRow.Delete
rdel2.Address = rdel2.Offset(-1, 0) "Error in this line"
End If
Next rdel2
I want to change the address of redel2 by offset(-1,0). I know it dosen't look the right way to write it but I am unable to get the right syntax to change it. Can someone help! Please!
After you execute
rdel2.EntireRow.Delete
rdel2 will be `Nothing' so any attempt to manipulate it will fail.
If it were not Nothing, and referenceing a cell in a row > 1, then
Set rdel2 = rdel2.Offset(-1, 0)
would work.
It's not clear exactly what you want to achieve, but this may get you started
Sub Demo()
Dim rdel1 As Range
Dim rdel2 As Range
Set rdel1 = Sheets("Sheet1").Range("A1:A100")
Dim rw As Long
For rw = rdel1.Rows.Count To 1 Step -1
Set rdel2 = rdel1.Cells(rw, 1)
If rdel2.Value = "No item selected" Then
rdel2.Offset(1, 0).EntireRow.Delete
End If
Next
End Sub
rdel2 is a range and .Offset(-1,0) returns a range, just do rdel2 = rdel2.Offset(-1, 0) if you want to change rdel2.
Although, in your case, the For Each loop will update rdel2 so this line will be useless (unless you are not showing all your code and there is actually more between the problematic line and the Next rdel2 statement)

Simple Excel VB Cell value change - Error #1004: Application-defind or object-defined error

i've been trying to fix this error for hours now and i can't seem to see what it is that i am doing wrong here.
My macro is as it follows:
Function testValueChange(cell As Range)
On Error GoTo ErrorHandler
Dim testValue As String
testValue = Range(cell.Address)
MsgBox testValue
Range("Q2") = "new value"
Exit Function
ErrorHandler:
MsgBox "Error #" & Err & " : " & Error(Err)
End Function
I am able to retrieve the "testValue" correctly and it is displayed on the MsgBox. However, when i try to set a new value to the cell "Q2", i get the error "Error #1004: Application-defined or object-defined error."
There are several entries for that error over the web but none of them in this situation when i'm trying to simply set a String value to an empty cell!
The cell "Q2" is empty, i've chosen that cell specifically because it is not merged, nor referenced on another function or anything.
Thanks in advance for all the help!
I'm on Linux OS right now so I can't test this in Excel, but try setting a range object first then assigning the value with .value property. i.e:
Dim RNG as Range
Set RNG = Range("Q2")
RNG.value = "new value"
If you not interested in a return then shahkalpesh has the answer, but if your interested in monitoring the macro silently when run from somewhere else then return boolean like so.
Function testValueChange(cell As Range) as boolean
TestValueChange = TRUE
On Error GoTo ErrorHandler
Dim testValue As String
testValue = Range(cell.Address)
MsgBox testValue
Range("Q2") = "new value"
Exit Function
ErrorHandler:
testValueChange = FALSE
End Function
Usage in a vba sub.
If testValueChange then
'process worked
Else
'process didn't work
End if
Unless testvalue was ment to be testValueChange and returned as a string?
You cannot assign values to cells, or change them in any manner, when calling from a Function (or from a call chain that has started by a Function). Only a Sub will work. The only exception is that function value can be assigned to the cell containing the function reference