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"
Related
I need some help. I am new to Excel VBA. I am trying to create a userform for stock inventory records and I been geting the automation error -2147467259. My problem is that the code works but after a few mouse clicks (10 or more) or after long usage, I keep getting this error. My code:
Private Sub cbPickID_Change()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim tbl_issuance As ListObject
Set tbl_issuance = shIssuance.ListObjects("tblIssuance")
If Not tbl_issuance.DataBodyRange Is Nothing Then
tbl_issuance.DataBodyRange.Delete
End If
Dim tbl_pick As ListObject
Set tbl_pick = shPickList.ListObjects("tblPickList")
On Error GoTo ErrDetect
With tbl_pick.DataBodyRange
.AutoFilter field:=1, Criteria1:=Me.cbPickID.Value
End With
Dim pick_row As Long
pick_row = shPickList.Range("A" & Application.Rows.Count).End(xlUp).Row
shPickList.Range("A3:L" & pick_row).SpecialCells(xlCellTypeVisible).Copy
shIssuance.Range("A3").PasteSpecial (xlPasteValuesAndNumberFormats)
tbl_pick.AutoFilter.ShowAllData
Application.CutCopyMode = False
Dim issued_row As Long
issued_row = shIssuance.Range("A" & Application.Rows.Count).End(xlUp).Row
With Me.lbPickList
.ColumnHeads = True
.ColumnCount = 12
.ColumnWidths = ("40,40,40,110,0,45,40,60,90,0,0,0")
.RowSource = shIssuance.Range("A3:L" & issued_row).Address
End With
ErrDetect:
If Err.Number = 1004 Then
MsgBox "No records found!"
Exit Sub
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
When I click debug, the error point at this
tbl_issuance.DataBodyRange.Delete
all my reference are in the same file. if I want to use the Excel VBA again, I need to close all Excel file and re-open them again.
any advice is highly appreciated.
I have the following code which uses two for loops (Prod and Dev)
There are many values in the array but i have taken only two for the example
What it does is, it copies the value from one excel to the other.
Now, there is a probability that file NSA_103_B_Roles.xls doesnot exist
In that case, i dont want the code to take any action, so i have put on error resume next
But still it is printing the value in the excel which doesnot exist,
What is the reason?
Private Sub CommandButton1_Click()
Prod = Array("ZS7_656", "PCO_656")
Dev = Array("NSA_103", "DCA_656")
For lngCounter1 = LBound(Dev) To UBound(Dev)
For lngCounter = LBound(Prod) To UBound(Prod)
On Error Resume Next
Set Zz2 = Workbooks.Open("C:\Users\*****\Desktop\New folder\" &
Dev(lngCounter1) & "_B_Roles.xls")
Zz2.Sheets(Dev(lngCounter1) & "_B_Roles").Range("A1").Value = "anirudh"
ThisWorkbook.Sheets(Prod(lngCounter)).Range("A2").Value =
Zz2.Sheets(Dev(lngCounter1) & "_B_Roles").Range("A1").Value
On Error GoTo 0
Next lngCounter
Next lngCounter1
End Sub
Try the code below, explanation inside the code's comments :
Private Sub CommandButton1_Click()
Dim Zz2 As Workbook
Prod = Array("ZS7_656", "PCO_656")
Dev = Array("NSA_103", "DCA_656")
For lngCounter1 = LBound(Dev) To UBound(Dev)
For lngCounter = LBound(Prod) To UBound(Prod)
' ==== this section starts the error handling ===
On Error Resume Next
Set Zz2 = Workbooks.Open("C:\Users\*****\Desktop\New folder\" & _
Dev(lngCounter1) & "_B_Roles.xls")
On Error GoTo 0
If Zz2 Is Nothing Then ' <-- unable to find the file
MsgBox "unable to find the specified file", vbCritical
Exit Sub
End If
' === Up to Here ===
Zz2.Sheets(Dev(lngCounter1) & "_B_Roles").Range("A1").Value = "anirudh"
ThisWorkbook.Sheets(Prod(lngCounter)).Range("A2").Value = Zz2.Sheets(Dev(lngCounter1) & "_B_Roles").Range("A1").Value
Next lngCounter
Next lngCounter1
End Sub
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
Hi I'm pretty new at the vba so please don't shoot my code :-).
I have a set of repaeting code's. I woukld like to simplify this code by using the code name with an increasing number. I can't get it to run. Can someone help me a bit on the road to get this going.
Below what I'm trying.
The second block is a part of the code now (it's 40 blocks of the same code only increasing the number)
Sub sheet41()
Dim i As Integer
Dim chkname As Integer
chkname = "SheetCheckBox" & i
i = 1
Do
i = i + 1
If chkname.Visible = False Then Exit Sub
If chkname.value = True Then
Sheets("Item_" & i).Select
Call Finalize
End If
Loop Until i = ThisWorkbook.Worksheets.Count
End Sub
This is the old code:
Sub Sheet1()
If SheetCheckBox1.Visible = False Then Exit Sub
If SheetCheckBox1.value = True Then
Sheets("Item_1").Select
Call Finalize
End If
End Sub
Sub Sheet2()
If SheetCheckBox2.Visible = False Then Exit Sub
If SheetCheckBox2.value = True Then
Sheets("Item_2").Select
Call Finalize
End If
End Sub
Sub Sheet3()
If SheetCheckBox3.Visible = False Then Exit Sub
If SheetCheckBox3.value = True Then
Sheets("Item_3").Select
Call Finalize
End If
End Sub
As you can see this should be possible to clean I asume.
This should do it. If finalize isn't called on a worksheet then the reason why is printed to the Immediate Window.
Sub ProcessWorkSheets()
Dim check As MSForms.CHECKBOX
Dim i As Integer
For i = 1 To Worksheets.Count
On Error Resume Next
Set check = Worksheets(i).OLEObjects("SheetCheckBox" & i).Object
On Error GoTo 0
If check Is Nothing Then
Debug.Print Worksheets(i).Name; " - Checkbox not found"
Else
If check.Visible And check.Value Then
Worksheets(i).Select
Call Finalize
Else
Debug.Print Worksheets(i).Name; " - Checkbox", "Visible", check.Visible, "Value:", check.Value
End If
End If
Set check = Nothing
Next
End Sub
If the checkboxes on the Sheet are ActiveX Controls, you can use this to access the checkboxes:
Sheets("sheet1").OLEObjects("chkTest").Object
if you want to change the value of a checkbox, use it like this:
Sheets("sheet1").OLEObjects("chkTest").Object.Value = True
now replace "sheet1" with your actual sheet name and change the "chkTest" to your string chkname
So your complete code should be like this:
Dim i As Integer
Dim sheetname As String
Dim chkname As String
sheetname = "YOUR SHEETNAME HERE"
For i = 1 To ThisWorkbook.Worksheets.Count Step 1
chkname = "SheetCheckBox" & i
If Sheets(sheetname).OLEObjects(chkname).Object.Visible = False Then Exit Sub
If Sheets(sheetname).OLEObjects(chkname).Object.Value = True Then
Sheets("Item_" & i).Select
Call Finalize
End If
Next i
I have the following code that works fine until the end of the MsgBox:
Sub CommentsAsFootnotes(myTemplate As Variant, ByRef footnotespage1 As String, ByRef footnotespage2 As String)
Dim rngTemp As Range
Dim rngComment As Range
Dim footnote As String
Dim i As Integer
On Error Resume Next
Set rngComment = myTemplate.Sheets("Seite 1 ").Range("B14:T35").SpecialCells(xlCellTypeComments)
On Error GoTo 0
i = 1
'If rngComment is Nothing
'Exit Sub
'End If
For Each rngTemp In rngComment
rngTemp.value = rngTemp.value & CStr(i)
rngTemp.Characters(Start:=Len(rngTemp.value), Length:=1).Font.Superscript = True
MsgBox rngTemp.Comment.Text
' error thrown here
Next rngTemp
footnotespage1 = footnote
End Sub
The message box is shown with the correct content.
However, when I click "OK", an error is thrown "Error 91, Object variable or with block variable not set" and the debugger highlights the line with the message box.
Do you have any idea what could cause this error?
It's because that current range doesn't have a comment inside, add an IF when the cell doesn't have any comment inside, like this :
If rngTemp.Comment Is Nothing Then
MsgBox "No Comment found !"
Else
MsgBox rngTemp.Comment.Text
End If