check if a range is empty in vba module - excel

I wanted to check if an excel range in empty in a section of code in user module.
I used the below code
Worksheets(yearsheet).Range("N" & rownum & ":DI").Select
If Application.WorksheetFunction.CountA(Selection) = 0 Then
Exit Sub
End If
I'm getting runtime error 1004. Can anyone tell whats my mistake?
Thanks in advance.
PS: rownum is integer variable and yearsheet is string variable. both these variables were updated properly in code prior to the above section of the code

"N" & rownum & ":DI" doesn't evaluate to a real address because it's missing the row number for the second half of the address. Also, you should avoid using Select statement whenever possible.
Assuming the whole range is in one row, this would work:
Sub test()
Dim yearsheet As String
Dim rownum As Integer
yearsheet = "Sheet2"
rownum = 2
If Application.WorksheetFunction.CountA(Worksheets(yearsheet) _
.Range("N" & rownum & ":DI" & rownum)) = 0 Then
Exit Sub
End If
End Sub

The best way to test if a selection is (not) empty in VBA:
' Tests if a selection of cells exists.
' #return true or false
Function isCellSelection() As Boolean
Dim r As range
isCellSelection = False
Set r = Selection.Cells
If IsEmpty(r) Then
isCellSelection = True
End If
End Function ' isCellSelection

Related

Application defined or object-defined error ('1004') [duplicate]

Is there some limit to what I can select in a range via VBA? Basically what I found is that if I were to hide an entire row while in a loop, it takes quite a while if there are lots of rows to hide.
ex) - Hide any row that doesn't have a value in column A
For i = 1 to 600
With Range("A" & i)
If .value = vbEmpty then .EntireRow.Hidden = True
End With
Next
The more speedy way of doing that is to make a single range that references each of those rows and then do a single ".entirerow.hidden = true" statement. And yes, I already have application.screenupdating = false set.
The problem I'm encountering is that if the string reference for the range is too long, it just fails.
The following code declares a function which accepts both a standard array of row numbers (in case the array is made before hand), as well as parameter arguments (in case you don't want to declare an array before hand, and the list of rows is small). It then creates a string which is used in the range reference.
Function GetRows(argsArray() As Long, ParamArray args() As Variant) As Range
Dim rngs As String
Dim r
For Each r In argsArray
rngs = rngs & "," & r & ":" & r
Next
For Each r In args
rngs = rngs & "," & r & ":" & r
Next
rngs = Right(rngs, Len(rngs) - 1)
Set GetRows = Range(rngs)
End Function
Function dfdfd()
Dim selList(50) As Long, j As Long
For i = 1 To 100
If i Mod 2 = 1 Then
selList(j) = i
j = j + 1
End If
Next
selList(50) = 101
GetRows(selList).Select
End Function
The 2nd function "dfdfd" is just used to give an example of when it fails. To see when it works, just make a new array with say - 5 items, and try that. It works.
Final (?) update:
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
Dim nRng As Range
t = Timer()
Application.ScreenUpdating = False
Set nRng = [A1]
For i = 1 To 6000
Set nRng = Union(nRng, Range("A" & i))
Next
nRng.RowHeight = 0
'nRng.EntireRow.Hidden = true
Application.ScreenUpdating = True
Debug.Print "Union (RowHeight): " & Timer() - t & " seconds"
'Debug.Print "Union (EntireRow.Hidden): " & Timer() - t & " seconds"
End Sub
Results:
Union (row height: 0.109375 seconds
Union (hidden row): 0.625 seconds
I think the magical function you're looking for here is Union(). It's built into Excel VBA, so look at the help for it. It does just what you'd expect.
Loop through your ranges, but instead of building a string, build up a multi-area Range. Then you can select or set properties on the whole thing at once.
I don't know what (if any) the limit on the number of areas you can build up in a single Range is, but it's bigger than 600. I don't know what (if any) limits there are on selecting or setting properties of a multi-area Range either, but it's probably worth a try.
A faster option might be to use the SpecialCells property to find the blanks then hide the rows:
Sub HideRows()
Dim rng As Range
Set rng = ActiveSheet.Range("A1:A600")
Set rng = rng.SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True
End Sub
This will only work on cells within the UsedRange, I think.
A minor speedup can be obtained if you set the RowHeight property to 0.
On my system it goes about twice as fast
(on 6000 iterations about 1.17 seconds versus 2.09 seconds)
You didn't mention what 'quite a while' is, and what version of XL you are using...
Your problem may be in part your row detect code that checks for a row you want to hide(?).
Here's my test code in XL 2003 (comment out one version then the other):
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
t = Timer()
Application.ScreenUpdating = False
For i = 1 To 6000
With Range("A" & i)
'If .Value = vbEmpty Then .EntireRow.Hidden = True
If .Value = vbEmpty Then .RowHeight = 0
End With
Next
Application.ScreenUpdating = True
Debug.Print Timer() - t & " seconds"
End Sub
There is a limit to the string length. I just encountered a similar problem and found that if the String Txt of
Range(Txt)
is larger then 255 characters my VBA throws an Error.eg. the code:
Debug.Print sheet1.Range("R2300,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
throws an error (256 characters in string) whereas the code
Debug.Print sheet1.Range("R230,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
has 255 characters and prints out "46" without Error. The number of Areas is in both cases the same.

Populate a vba ComboBox with the values from the drop-down list of a cell

I want to populate a comboBox with the drop-down values found in a particular cell, say C10.
C10 uses Excel's Data Validation functionality to limit the values that can be entered into a cell to a drop-down list. I want to use this list to populate the comboBox in a vba userForm.
Currently my approach is to use:
Range("C10").Validation.Formula1
Here is 3 arbitrary examples of what this can return:
"=Makes"
"=INDIRECT(C9 & "_MK")"
"0;1;2;3;4;5;6;7;8;9;10"
My approach is to evaluate this and try to form it into a usable range that can be used to set the RowSource property of my comboBox. However, I can't account for every feasible case that can be returned.
Surely there is a short and simple way to achieve what I want without without coding an exception for every case.
What is the correct way of doing this?
However, I can't account for every feasible case that can be returned.
You will have to account for it separately. There is no direct way to get those values.
Here is a quick code GetDVList() that I wrote which will handle all your 3 scenarios.
The below code will return the values of the Data Validation list in an array from which you can populate the Combobox. I have commented the code so you should not have a problem understanding it but if you do then simply ask.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim rng As Range
Dim i As Long
Dim cmbArray As Variant
'~~> Change this to the relevant sheet and range
Set rng = Sheet1.Range("A1")
'~~> Check if range has data validation
On Error Resume Next
i = rng.SpecialCells(xlCellTypeSameValidation).Count
On Error GoTo 0
'~~> If no validation found then exit sub
If i = 0 Then
MsgBox "No validation found"
Exit Sub
End If
'~~> The array of values
cmbArray = GetDVList(rng)
'~~> You can transfer these values to Combobox
For i = LBound(cmbArray) To UBound(cmbArray)
Debug.Print cmbArray(i)
Next i
End Sub
Function GetDVList(rng As Range) As Variant
Dim tmpArray As Variant
Dim i As Long, rw As Long
Dim dvFormula As String
dvFormula = rng.Validation.Formula1
'~~> "=Makes"
'~~> "=INDIRECT(C9 &_MK)"
If Left(dvFormula, 1) = "=" Then
dvFormula = Mid(dvFormula, 2)
rw = Range(dvFormula).rows.Count
ReDim tmpArray(1 To rw)
For i = 1 To rw
tmpArray(i) = Range(dvFormula).Cells(i, 1)
Next i
'~~> "0;1;2;3;4;5;6;7;8;9;10"
Else
tmpArray = Split(dvFormula, ",") '~~> Use ; instead of , if required
End If
GetDVList = tmpArray
End Function
Please, test the next code. It works with the assumption that a List Validation formula can only return a Range or a list (array). Theoretically, it should evaluate any formula and extract what it returns, in terms of a Range or a List:
Sub comboListValidation()
Dim cel As Range, arr, arrV
Dim cb As OLEObject 'sheet ActiveX combo
Set cb = ActiveSheet.Shapes("ComboBox1").OLEFormat.Object
Set cel = ActiveCell 'instead of active cell you can use what you need
'even a cell resulted from iteration between `sameValidation` range
arrV = isCellVal(cel) 'check if chell has validadion (and DropDown type)
If Not arrV(0) Then
MsgBox "No validation for cell """ & cel.Address & """.": Exit Sub
ElseIf Not arrV(1) Then
MsgBox "cell """ & cel.Address & """ has validation but not DropDown type.": Exit Sub
End If
arr = listValidation_Array(cel)
With cb.Object
.Clear 'clear the existing items (if any)
.list = arr 'load the combo using arr
End With
MsgBox "Did it..."
End Sub
Private Function listValidation_Array(cel As Range) As Variant
Dim strForm As String, rngV As Range, strList As String, arr
strForm = cel.Validation.Formula1 'extract Formula1 string
On Error Resume Next
Set rngV = Application.Evaluate(strForm) '!!!try setting the evaluated range!!!
If Err.Number = 424 Then 'if not a Range, it must be a list (usually, comma separated)
Err.Clear: On Error GoTo 0
listValidation_Array = Split(Replace(strForm, ";", ","), ",") 'treat the ";" sep, too
Else
On Error GoTo 0
listValidation_Array = rngV.Value 'extract the array from range
End If
End Function
Function isCellVal(rng As Range) As Variant
Dim VType As Long
Dim boolValid As Boolean, boolDropDown As Boolean
On Error Resume Next
VType = rng.Validation.Type 'check if validation exists
On Error GoTo 0
If VType >= 1 Then 'any validation type
boolValid = True
If VType = 3 Then boolDropDown = True 'dropDown type
End If
ReDim arr(1) : arr(0) = boolValid: arr(1) = boolDropDown
isCellVal = arr
End Function

For Loop statement VBA Excel 2016

Proper syntax Match and If not isblank
I need some assistance with creating a loop statement that will determine the range start and end where a particular criteria is met.
I found these statements on the web and need help to modify them to loop thru two different worksheets to update a value on 1 of the worksheets.
This one has an issue returning True or False value for the Range when I want to pass the actual named range for look up where this field = Y, then returns the value from another column. I original tried using Match and If is not blank function. But that is very limiting.
See the previous post to see what I am trying to accomplish - I know I will need to expand the code samples and probably will need help with this modification.
Sub Test3()
Dim x As Integer
Dim nName As String
Sheets("BalanceSheet").Select
nName = Range("qryDifference[[Validate Adjustment]]").Select
Debug.PrintnName
' Set numrows = number of rows of data.
NumRows = Range(nName, Range(nName).End(xlDown)).Rows.Count
' Select cell a1.
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' Insert your code here.
MsgBox"Value found in cell " & ActiveCell.Address
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
This is what I have so far - this is giving me and issue with
ActiveCell.Offset(4, 0).Select
nAgentNo = Range("qryDifference[[agtno]]").Value
nValidate = Range("ryDifference[[Difference]]").Value
Debug.Print nAgentNo
Debug.Print nValidate
Type mismatch error on the above.
Sub Revised_AgentAmount()
Dim myRange As Range
Dim i As Long, j As Long
Dim nAgentNo As String
Dim nValidate As Long
Sheets("BalanceSheet").Select
Set myRange = Range("qryDifference[[Validate Adjustment]]")
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
If myRange(i, j).Value = "Y" Then
ActiveCell.Offset(4, 0).Select
nAgentNo = Range("qryDifference[[agtno]]").Value
nValidate = Range("ryDifference[[Difference]]").Value
Debug.Print nAgentNo
Debug.Print nValidate
End If
Next j
Next i
End Sub
In your first statement you declare nName as a String then try to select it. You would need to declare it as a Range if you are going to use it as a Range object.
I found solution elsewhere with a if statement instead of the for loop.
=IF([#agtno]=B24,[#[agt_amt]],SUMPRODUCT((Balance!$B$2:$B$7=[#agtno])*(Balance!$F$2:$F$7="Y")*Balance!$E$2:$E$7)+[#[agt_amt]])

Excel Vba Code to Check Quantity in a Column

I have a macro to format a spreadsheet. I need some excel vba code to add to the start to check that the Quantity in a column is always '1'
The code needs to check the column from cell H2 to the bottom of the data in H2 (until it finds a blank cell).
If all the values are '1' do nothing and continue running the macro. If it finds any other number (either negative or positive) display a MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!" then when 'OK' is selected exit the macro.
Something like this:
Sub YourExistingCode()
If QuantityErrorFound Then
MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"
Exit Sub
Else
'~~> Run your code
End If
End Sub
Function QuantityErrorFound() As Boolean
Dim cl As Range, result As Boolean
result = False
For Each cl In Range("H2:H" & Range("H2").End(xlDown).Row)
If cl.Value <> 1 Then
result = True
End If
Next cl
QuantityErrorFound = result
End Function
I've used a function (QuantityErrorFound) to make it easier to integrate into your existing code
In your existing code simply add the if statement to check whether an error is found
Just a slight change to Alex P's code really. As you're dealing with 1s a simple sum will be quicker than a loop
Function QuantityErrorFound() As Boolean
Dim result As Boolean
Dim lastR as long
Dim sumCells as long
Dim cntCells as Long
result = False
'lastR = Range("H2").End(xlDown).Row
lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row '<< assuming below the last cell is empty then this is a better approach to above line.
sumCells = Excel.Application.Sum(Range("H2:H" & lastR))
cntCells = Range("H2:H" & lastR).cells.count
if (sumCells = cntCells) then
result = True
end if
QuantityErrorFound = result
End Function
Personally in my work spreadsheets I would use a formula in a hidden cell (named range called "ErrorCheck") like this:
=if(countif(H2:H10000,"<>1")>0,"error","ok")
Then in my vba all I need is the following:
if ((range("ErrorCheck") = "error") then
MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"
else
...
...
Edit
Please see flaw in my check as pointed out by Ian Cook. I will leave the code as is - but you should force values in column H to be either 1 or 0 if using the above. This could be done with a simple formula:
=if(<current formula>=1,1,0)
or
=1*(<current formula>=1)
Or, defend Ian's possible problem, by changing the Sum in my vba to a countIf:
Function QuantityErrorFound() As Boolean
Dim result As Boolean
Dim lastR as long
Dim sumCells as long
Dim cntCells as Long
result = False
'lastR = Range("H2").End(xlDown).Row
lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row '<< assuming below the last cell is empty then this is a better approach to above line.
sumCells = Excel.Application.WorksheetFunction.CountIf(Range("H2:H" & lastR),"=1") '<<not tested and may need to read ...,1)
cntCells = Range("H2:H" & lastR).cells.count
if (sumCells = cntCells) then
result = True
end if
QuantityErrorFound = result
End Function
Then again if using the above it could be simplified to the following:
Function QuantityErrorFound() As Boolean
Dim result As Boolean
Dim lastR as long
Dim sumCells as long
result = False
lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row
sumCells = Excel.Application.WorksheetFunction.CountIf(Range("H2:H" & lastR),"<>1")
if (sumCells = 0) then
result = True
end if
QuantityErrorFound = result
End Function

Excel VBA :: Find function in loop

I'm trying to loop through several worksheets that contain some source data that has to be copied to one main sheet, called "PriorityList" here.
First of all, the sub is not working and I think the error is somewhere in the "find"-method. Second, the sub takes quite long to run, and I think this is maybe because the "find"-method searches through the whole sheet instead of only the relevant range?
Thank you very much for your answers!
Patrick
Sub PriorityCheck()
'Sub module to actualise the PriorityList
Dim CurrWS As Long, StartWS As Long, EndWS As Long, ScheduleWS As Long
StartWS = Sheets("H_HS").Index
EndWS = Sheets("E_2").Index
Dim SourceCell As Range, Destcell As Range
For CurrWS = StartWS To EndWS
For Each SourceCell In Worksheets(CurrWS).Range("G4:G73")
On Error Resume Next
'Use of the find method
Set Destcell = Worksheets(CurrWS).Cells.Find(What:=SourceCell.Value, After:=Worksheets("PriorityList").Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'Copying relevant data from source sheet to main sheet
If Destcell <> Nothing Then
Destcell.Offset(0, 2).Value = SourceCell.Offset(0, 5).Value + Destcell.Offset(0, 2).Value
If SourceCell.Offset(0, 3).Value = "x" Then Destcell.Offset(0, 3).Value = "x"
End If
End If
On Error GoTo 0
Next SourceCell
Next CurrWS
End Sub
here short sample how to use 'Find' method to find the first occurrence of the source.Value in the priorityList.
Source cell is one of the cells from the range "G4:G73" and priorityList is used range on "PriorityList" sheet. Hope this helps.
Public Sub PriorityCheck()
Dim source As Range
Dim priorityList As Range
Dim result As Range
Set priorityList = Worksheets("PriorityList").UsedRange
Dim i As Long
For i = Worksheets("H_HS").Index To Worksheets("E_2").Index
For Each source In Worksheets(i).Range("G4:G73")
Set result = priorityList.Find(What:=source.Value)
If (Not result Is Nothing) Then
' do stuff with result here ...
Debug.Print result.Worksheet.Name & ", " & result.Address
End If
Next source
Next i
End Sub
Here is an approach using arrays. You save each range into an array, then iterate through array to satisfy your if-else condition. BTW IF you want to find the exact line with code error, then you must comment On Error Resume Next line.. :) Further, you can simply store the values into a new array, dump everything else into the main sheet later after iterating through all the sheets instead of going back and forth to sheets, code, sheets..code..
Dim sourceArray as Variant, priorityArray as Variant
'-- specify the correct priority List range here
'-- if multi-column then use following method
priorityArray = Worksheets(CurrWS).Range("A1:B10").Value
'-- if single column use this method
' priorityArray = WorkSheetFunction.Transpose(Worksheets(CurrWS).Range("A1:A10").Value)
For CurrWS = StartWS To EndWS
On Error Resume Next
sourceArray = Worksheets(CurrWS).Range("G4:J73").Value
For i = Lbound(sourceArray,1) to UBound(sourceArray,1)
For j = Lbound(priorityArray,1) to UBound(priorityArray,1)
If Not IsEmpty(vArr(i,1)) Then '-- use first column
'-- do your validations here..
'-- offset(0,3) refers to J column from G column, that means
'---- sourceArray(i,3)...
'-- you can either choose to update priority List sheet here or
'---- you may copy data into a new array which is same size as priorityArray
'------ as you deem..
End If
Next j
Next i
Next CurrWS
PS: Not front of a MS Excel installed machine to try this out. So treat above as a code un-tested. For the same reason I couldn't run your find method. But it seems odd. Don't forget when using match or find it's important to do proper error handling. Try checking out [find based solutions provided here.
VBA in find function runtime error 91
Excel 2007 VBA find function. Trying to find data between two sheets and put it in a third sheet
I have edited the initial code to include the main logic using two array. Since you need to refer to values in J column of source sheets, you will need to adjust source array into a two-dimensional array. So you can do the validations using first column and then retrieve data as you desire.
For everyone maybe interested, this is the code version that I finally used (pretty similar to the version suggested by Daniel Dusek):
Sub PriorityCheck()
Dim Source As Range
Dim PriorityList As Range
Dim Dest As Range
Set PriorityList = Worksheets("PriorityList").UsedRange
Dim i As Long
For i = Worksheets("H_HS").Index To Worksheets("S_14").Index
For Each Source In Worksheets(i).Range("G4:G73")
If Source <> "" Then
Set Dest = PriorityList.Find(What:=Source.Value)
If Not Dest Is Nothing Then
If Dest <> "" Then
Dest.Offset(0, 2).ClearContents
Dest.Offset(0, 2).Value = Source.Offset(0, 5).Value + Dest.Offset(0, 2).Value
End If
If Source.Offset(0, 3).Value = "x" Then Dest.Offset(0, 3).Value = "x"
Debug.Print Dest.Worksheet.Name & ", " & Dest.Address
End If
End If
Next Source
Next i
MsgBox "Update Priority List completed!"
End Sub

Resources