There are some validated cells. I should check that a cells has validation or not. If it has validation i should get the range of its validation.
Are there any method for it?
I'ce tried a lot of formulas but it was unsuccessfull.
Sub checkForValidation()
Dim cell As Range, v As Long
adatOszlop = 9
todoszamlalo = 0
celOszlop = 15
Set lista = Sheets("Munka1").Range("R:R")
lista.Name = "Szamok"
For szamlalo = 4 To 25
v = 0
On Error Resume Next
v = Cells(szamlalo, celOszlop).SpecialCells(xlCellTypeSameValidation).Count
On Error GoTo 0
If v = 0 Then
Debug.Print "No validation"
Cells(szamlalo, 10) = "No validation"
Else
Debug.Print "Has validation"
Cells(szamlalo, 10) = "Has validation"
If Not lista.Find(Cells(szamlalo, adatOszlop).Value) Is Nothing Then
Dim rng As Range
Dim ws As Worksheet
Sheets("Munka1").Cells(szamlalo, 14) = "ok"
Sheets("Munka1").Cells(szamlalo, celOszlop) = Cells(szamlalo, adatOszlop).Value
Else
Call selectsub(Cells(szamlalo, adatOszlop).Value)
End If
End If
Next
'End
End Su
b
This little sub tests the active cell and gives the range of the DV list or lists the DV items or tells you there is no DV:
Sub IsIt()
On Error GoTo trap
MsgBox ActiveCell.Validation.Formula1
On Error GoTo 0
Exit Sub
trap:
MsgBox "no data validation"
On Error GoTo 0
End Sub
Related
I have been receiving a "Next without For" error code on my current VBA project. I do not see where the issue is to fix it. I have a For and If prior to the Next I but have ended both statements prior to the Next I. Any help or fresh pair of eyes would be appreciated.
Code
Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo errHandler
Dim ID As String
Dim I As Integer
Dim cNum As Long, X As Long
Dim findvalue As Range
On Error GoTo errHandler:
For I = 0 To lstLookup.ListCount - 1
If lstLookup.Selected(I) = True Then
ID = lstLookup.List(I, 14)
If lstLookup.Selected(I) = False Then
Exit For
End If
**Next I**
If VBA.Len(ID) < 1 Then
MsgBox "No data found"
Cancel = True
Exit Sub
End If"
Let's say i have this value "ABC123" in Sheet1.Range("A1")
I want to search for/ match this value in Sheet2.Range("A1:A10") // or the column
If the value is found
//msgbox "Found"
else
//msgbox "Not found"
end if
try this:
Sub foo()
Dim t As Long
On Error Resume Next
t = Application.WorksheetFunction.Match(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet2").Range("A:A"), 0)
On Error GoTo 0
If t > 0 Then
MsgBox "Found"
Else
MsgBox "Not found"
End If
End Sub
Try using the Match function below (you will get the row number found):
Option Explicit
Sub MatchTest()
Dim MatchRes As Variant
MatchRes = Application.Match(Worksheets("Sheet1").Range("A1").Value, Worksheets("Sheet2").Range("A1:A10"), 0)
If IsError(MatchRes) Then
MsgBox "Not found"
Else
MsgBox "Found at row " & MatchRes
End If
End Sub
Consider:
Sub dural()
Dim s As String, r1 As Range, r2 As Range, r3 As Range
Set r1 = Sheet1.Range("A1")
Set r2 = Sheet2.Range("A1:A10")
s = r1.Value
Set r3 = r2.Find(what:=s, after:=r2(1))
If r3 Is Nothing Then
MsgBox "not found"
Else
MsgBox "Found"
End If
End Sub
just playing around a little bit with Scott's solution:
Sub foo2()
Dim t As Long
On Error GoTo NotFound
t = Application.WorksheetFunction.Match(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet2").Range("A:A"), 0)
MsgBox "Found
Exit Sub
NotFound:
MsgBox "Not found"
End Sub
This VBA script should take the value in the cell A37 and check if its in the C column of another worksheet. When the number is found the column to the left should be changed to 0. If it is already 0 then a message box will inform the user and if the number does not exist another message box will inform them of this.
This is the VBA I am using to accomplish this. However, every time I try to run it there is a "compile error: Next without For"
Update This issue now is that I need to activate the cell that the fcell is in before doing an Active.cell offset
Sub Cancelled()
Dim x As Long
Dim regRange As Range
Dim fcell As Range
x = ThisWorkbook.Sheets("Welcome").Range("A37").Value
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
For Each fcell In regRange.Cells
If fcell.Value = x Then
ActiveCell.Offset(0, -1).Select
If ActiveCell.Value = 1 Then
ActiveCell.Value = 0
MsgBox "Changed to zero"
Exit Sub
Else
MsgBox "That registration number is already cancelled"
Exit Sub
End If
End If
Next fcell
MsgBox "That number does not exist"
End Sub
Edit for new question: No need to use Select and ActiveCell
If fcell.Value = x Then
If fcell.Offset(0,-1).Value = 1 Then
fcell.Offset(0,-1).Value = 0
...
Edit 2: A further suggestion: You could also use the Range.Find method. This will throw an error if nothing is found so you have to catch that:
On Error Resume Next 'If an error occurs, continue with the next line
Set fcell = regRange.Find(x)
On Error GoTo 0 'disable the error handler
If fcell Is Nothing Then 'If Find failed
MsgBox "That number does not exist"
Else
'do your stuff with fcell here
End If
Hope this is not too late to answer your question:
Sub Cancelled()
Dim x As Long
Dim regRange As Range
Dim fcell As Range
x = ThisWorkbook.Sheets("Welcome").Range("A7").Value
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
For Each fcell In regRange.Cells
If fcell.Value = x Then
If fcell.Offset(0, -1).Value = 1 Then
fcell.Offset(0, -1).Value = 0
MsgBox "Changed to zero"
Else
MsgBox "That registration number is already cancelled"
End If
Exit Sub
End If
Next fcell
MsgBox "That number does not exist"
End Sub
Instead of
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
its better to get the last row in Column C and then set your range as:
Dim lastRow As Long
lastRow = ThisWorkbook.Sheets("Registration").Cells(Rows.Count, "C").End(xlUp).Row
Set regRange = ThisWorkbook.Sheets("Registration").Range("C1:C" & lastRow)
I have two listboxes in my script which are populated with Month values and Year values. If the listbox is populated with values, it writes them to a worksheet, whereas if they are blank, it should throw an error.
I created a test scenario where I have two blank listboxes, the code below should throw a message box advising the user to select a value before executing the script. However, VBA has a mind of its own and thinks that the list boxes are populated with values, therefore I get:
Runtime Error 1004 - Unable to get the List property of the DropDown class
Is there something wrong with the code below that I am not seeing?
Sub TestDropDown()
Dim MonthBox As DropDown, YearBox As DropDown
Dim WB As Workbook
Dim WS4 as Worksheet
Set WB = ThisWorkbook
Set WS4 = WB.Worksheets("Config")
Set MonthBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 8")
Set YearBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 9")
'Check Monthbox for values
If IsNull(MonthBox.Value) Then
MsgBox ("Select a Month before running the script")
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 9).Value = MonthBox.List(MonthBox.Value)
End If
'Check Yearbox for values
If IsNull(YearBox.Value) Then
MsgBox "Please select a Year before running the script", vbExclamation
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 10).Value = YearBox.List(YearBox.Value)
End If
EndSub:
If Failvalue = 0 Then
MsgBox ("Process complete")
Else
MsgBox "Process failed to complete", vbCritical
End If
WS4.Visible = xlSheetHidden
End Sub
You should check the .ListIndex instead of the .Value. If ListIndex returns zero, it means none is selected.
Try this:
Sub TestDropDown()
Dim MonthBox As DropDown, YearBox As DropDown, Failvalue As Integer
Dim WB As Workbook
Dim WS4 As Worksheet
Set WB = ThisWorkbook
Set WS4 = WB.Worksheets("Config")
Set MonthBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 8")
Set YearBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 9")
'Check Monthbox for values
'If IsNull(MonthBox.Value) Then
If MonthBox.ListIndex = 0 Then
MsgBox ("Select a Month before running the script")
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 9).Value = MonthBox.List(MonthBox.ListIndex)
End If
'Check Yearbox for values
'If IsNull(YearBox.Value) Then
If YearBox.ListIndex = 0 Then
MsgBox "Please select a Year before running the script", vbExclamation
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 10).Value = YearBox.List(YearBox.ListIndex)
End If
EndSub:
If Failvalue = 0 Then
MsgBox ("Process complete")
Else
MsgBox "Process failed to complete", vbCritical
End If
WS4.Visible = xlSheetHidden
End Sub
It looks like the following line of code wasn't sufficent as the listbox value wasn't equating to null.
If IsNull(YearBox.Value) then
If a ran a msgbox on the listbox value, it was returning 0 on a blank listbox so I changed the code to the following
If YearBox.Value = 0 then
This works fine!
So this code works until you decide to hit Cancel or close the inputbox window with the X at which point it gives you:
Run-time error '424':
Object required
and then it highlights this part of the code in debug:
Set ranC = Application.InputBox("Select the Cal B table.", Type:=8)
I can't seem to use the zero string length string test for canceling with this application. I need to be able to close the current workbook, show a userform and exit the sub.
Here is my code: (the code works as long as you select something and don't cancel or close)
Sub popCheckVals()
Dim ranC As Range, calBC(1 To 39) As Variant, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set ranC = Application.InputBox("Select the Cal B table.", Type:=8)
l = 1
For j = 1 To 13
For i = 1 To 3
calBC(l) = ranC(j, i)
l = l + 1
Next
Next
mltn = calBC(1)
mlte = calBC(2)
mltelev = calBC(3)
rltn = calBC(4)
rlte = calBC(5)
rltelev = calBC(6)
mrtn = calBC(10)
mrte = calBC(11)
mrtelev = calBC(12)
rrtn = calBC(13)
rrte = calBC(14)
rrtelev = calBC(15)
smltn = calBC(22)
smlte = calBC(23)
smltelev = calBC(24)
srltn = calBC(25)
srlte = calBC(26)
srltelev = calBC(27)
smrtn = calBC(31)
smrte = calBC(32)
smrtelev = calBC(33)
srrtn = calBC(34)
srrte = calBC(35)
srrtelev = calBC(36)
ActiveWorkbook.Close
dozerCal.Show
End If
End Sub
When the user clicks the Cancel button InputBox returns False, which is not a Range object and can't be assigned to ranC. One way to handle this is to wrap this part of the code in an error handler:
On Error Resume Next
Set ranC = Application.InputBox("Select the Cal B table.", Type:=8)
If Err.Number = 424 Then
' Handle cancel button
Debug.Print "User cancelled"
Exit Sub
ElseIf Err.Number <> 0 Then
' Handle unexpected error
Debug.Print "Unexpected error"
Else
' Your code here
End If
On Error GoTo 0 ' This line could go in the else block