Hi I need help with my code it supposed to delete the rows in my
sheets once the item is selected in the listbox, it is kind of strange when I run it it didn't delete the item I selected but it deleted the one above it:
Private Sub clearselected()
Dim I As Long
On Error Resume Next
With ListBox1
For I = .ListCount - 1 To 0 Step -1
If .Selected(I) Then
.RemoveItem I
With Sheets("Expenses")
.Rows(I + 2).EntireRow.Delete
.Shape("Listbox1").ControlFormat.ListFillRange = _
.Range("B:B").Address
End With
End If
todaysDate.Text = ""
TextBox11.Text = ""
TextBox13.Text = ""
TextBox12.Text = ""
TextBox4.Text = ""
Next I
End With
End Sub
As mentioned in the comments, you should change i+2 to i+3, because of the different starting index of the row and the ListBox.
However, whenever you have a problem like this, simply try some "advanced" debugging, telling you exactly what is happening:
With Sheets("Expenses")
MsgBox (i + 2 & " is going to be deleted!")
.Rows(i + 2).EntireRow.Delete 'or just .Rows(i + 2).Delete
.Shape("Listbox1").ControlFormat.ListFillRange = _
.Range("B:B").Address
End With
Thus, before deleting you will see the MsgBox, telling you what is going to happen. If you are not happy with it, it is easy to change i+2 to i+3 and etc.
Related
I'm trying to execute an if statement that only activates if a certain cell contains a specific text. The cell in question needs to be dynamically altered based on a integer that will change, so far ive tried multiple methods but nothing seems to work.
If Cells(counter, 1).text = "text" then
If Cells(counter, 1).value = "text" then
If Range(Cells(counter, 1)).text = "text then
If Range(Cells(counter, 1)).value = "text then
This seems like a simple procedure, does someone have a solution?
Thanks, Sporre
Edit:
Private Sub CheckBox_Change()
If CheckBox.Value = True Then
'do stuff
End If
ElseIf CheckBox.Value = False Then
If Cells(1, counter).Value = "text1" Or Cells(1, counter).Value =
"text2" Or Cells(1, counter).Value = "text3" Then
'do stuff
End If
End If
End Sub
This is where i get the error message "Application-definded or Object-defined error".
Edit 2:
The problem was I tried to call for the counter in several different subs and it was not a public integer. Thanks for your help!
This one will work
if (Trim(ThisWorkbook.Worksheets("Sheet1").Cells(counter, 1).Value)="text") Then
You cannot use End If and then follow up with and ElseIf. The first one ends the If statement entirely, meaning that the you would have to begin a new one. Based on you edit, I think your code should look something like this:
Private Sub CheckBox_Change()
If CheckBox.Value = True Then
'do stuff
ElseIf CheckBox.Value = False Then
If (Counter < 1) Then
'Show an error if the counter is less than 1
MsgBox "Error: Counter less than 1", vbCritical
ElseIf Cells(1, counter).Value = "text1" Or Cells(1, counter).Value = "text2" Or Cells(1, counter).Value = "text3" Then
'do stuff
End If
End If
End Sub
This should work:
If Worksheets("Name of your worksheet").Cells(counter, 1).Value)="text" Then
'execute some code
End if
I have a small script that sort of does what I need it to do, but I'm afraid at some point there will be more than 4 characters in a cell and I don't want to delete it. The logic that I want to employ is as follows:
If any cell in BB1:BB10 contains ONLY Chr(10) then move the contents of the cells below up one cell. Something like this
Public Sub CheckHisMethod()
Dim i As Integer
i = 1
For i = 10 To 1 Step -1
If Excel.ActiveSheet.Range("BB" & i).Value = Chr(10) Then ' or =vblf or =chr$(10)
Excel.ActiveSheet.Range("BB" & i).Delete Shift:=xlUp
End If
Next i
MsgBox "Done"
End Sub
But...I don't want to delete the Chr(10) from each cell, I only want to delete the cell, and move the cell below up one cell, if the cell contains ONLY Chr(10). How can I do that?
Please try the following. It removes all CHR(10) and then it checks if the length of the resulting string is 0, meaning all characters in the cell are CHR(10).
Public Sub CheckHisMethod()
Dim i As Integer
i = 1
For i = 10 To 1 Step -1
If Len(Replace(Excel.ActiveSheet.Range("BB" & i).Value,Chr(10),"")) = 0 Then ' or =vblf or =chr$(10)
Excel.ActiveSheet.Range("BB" & i).Delete Shift:=xlUp
End If
Next i
MsgBox "Done"
End Sub
I'd personally use a regular expression for this - it will likely be much faster than other string manipulations:
'Add a reference to Microsoft VBScript Regular Expressions 5.5
Public Sub CheckHisMethod()
Dim i As Integer
With New RegExp
.Pattern = "^[\n]+$"
.MultiLine = True
For i = 10 To 1 Step -1
If .Test(Excel.ActiveSheet.Range("BB" & i).Value) Then
Excel.ActiveSheet.Range("BB" & i).Delete Shift:=xlUp
End If
Next i
End With
MsgBox "Done"
End Sub
So im writing a program for my coursework and im pretty stuck ive got all my values inputed in the correct cells but i want to make sure that if a row is free inbetween the ones already there the code will be input there. So far its just looking for last row and putting it there even if there is a space inbetween.
Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Details")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
ws.Range("A" & LastRow).Value = Forename.Value 'Adds the TextBox into Col A & Last Blank Row
ws.Range("B" & LastRow).Value = Surname.Value
ws.Range("C" & LastRow).Value = School.Value
ws.Range("E" & LastRow).Value = Candidate.Value
This is what i have which works. Also how can i make sure that if the user puts a special character such as "!"£$%^&*(){}[]:;#'~#?><,./|\" or a number within a textbox to show a message box saying its incorrect i did it for numbers but dont know how to do it for this.
If Len(Candidate.Value) > 4 Then
MsgBox "The Candidate number is too long"
End If
If IsNumeric(Candidate.Value) = False Then
MsgBox "Candidate number contains characters other than numbers"
End If
Thanks in advance look forward to seeing your replies
This is the whole code for the submit button
Private Sub Submit_click()
'Output all information into the spreadsheet
If Forename.Value = "" Then
Me.Forename.SetFocus
MsgBox "The Forename is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If Surname.Value = "" Then
Me.Surname.SetFocus
MsgBox "The Surname is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If School.Value = "" Then
Me.School.SetFocus
MsgBox "The School you previously attended to is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If Candidate.Value = "" Then
Me.Candidate.SetFocus
MsgBox "The Candidate number is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If IsNumeric(Candidate.Value) = False Then
MsgBox "Candidate number contains characters other than numbers" 'Validation Check - makes sure only numbers are entered
End If
If Trim(Me.Candidate.TextLength > 4) Then
Me.Candidate.SetFocus
MsgBox ("Candidate Number Contains more than 4 characters") 'Validation Check - Makes sure that no more than 4 characters are entered
End If
If Trim(Me.Candidate.TextLength < 4) Then
Me.Candidate.SetFocus
MsgBox ("Candidate Number Contains less than 4 characters") 'Validation Check - Makes sure that no less than 4 characters are entered
End If
Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Details")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
'This is the stuff i had before that are quoted out i dont know what to use
'ws.Range("A" & LastRow).Value = Forename.Value 'Adds the TextBox into Col A & Last Blank Row
'ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Forename.Value
'ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Surname.Value
'ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(0, 2).Value = School.Value
'ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(0, 3).Value = Candidate.Value
'Sub fillstuff()
Range("A:a").End(xlDown).Offset(-1, 0).Value = "Forename"
Range("A:a").End(xlDown).Offset(-1, 1).Value = "Surname"
Range("A:a").End(xlDown).Offset(-1, 2).Value = "School"
Range("A:a").End(xlDown).Offset(-1, 3).Value = "Candidate"
This is all the stuff i have underneath my submit button all the validation checks work they all give messages but the last code after the quote where i mentioned doesnt work at all. What do i need to do in order to make that work
Ya killin me smalls <3
Here is everything you asked for in the order it should probably look in your module/userform code. Since youre new to this it is worth pointing out that the order of execution matters. Once you start working with larger object sets and more complicated types of calculations, trouble shooting often entails figuring out where what value was set in the execution order. That was probably the biggest headache for in my first larger macro set.
Sub CommandButton1_Click()
Dim somestuff As somestuff
'this checks textbox1 for more than 4 digits in length
If Trim(Me.TextBox1.TextLength > 4) Then
Me.TextBox.SetFocus
MsgBox ("you have entered more than 4 characters")
Exit Sub
End If
'Some other code
'more code to do stuff
Range("A:a").End(xlDown).Offset(-1, 0).Value = "Forename"
Range("A:a").End(xlDown).Offset(-1, 1).Value = "Surname"
Range("A:a").End(xlDown).Offset(-1, 2).Value = "School"
Range("A:a").End(xlDown).Offset(-1, 3).Value = "Candidate"
'This makes the userform "disappear" after execution. Might Not be needed for your purpose
Unload Me
End Sub
Sub CommandButton2_Click()
'as a habit i tend to create "clear" command buttons as well
TextBox1.Value = vbNullString
TextBox2.Value = vbNullString 'also its a good habit to use vbNullString instead of ""
End Sub
'this prevents user from entering nonnumerics in textbox 1
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyLeft, _
vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
Case Else
KeyAscii = 0
Beep
End Select
End Sub
'this assumes that the text box for letters only is a different text box. You would_
' need to duplicate this type of data validation per text box
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0
End Sub
I've got a lot of hyperlinks and I want to assign a macros to each of them and Worksheet_FollowHyperlink captures only Inserted Hyperlinks but not the HYPERLINK() function. So I want my Inserted Hyperlinks refer to nothing so when I press them nothing happens. Or I want them to refer themselves. But when I just copy one to another cell it still refers to its parents cell. So I have to edit a new one so it refers to its new cell. And I've got hundreeds of hyperlinks to be copied and edited as well. I need that because I don't want the hyperlinks skip me to the parent hyperlink's cell.
Thanks in advance
You will be better off using the HYPERLINK() function. You can use it for what you want like this:
=HYPERLINK("#HyperlinkClick()", "Text you want to Display")
Notice the # at the beginning. This is important.
Now create a function called HyperlinkClick:
Function HyperlinkClick()
Set HyperlinkClick = Selection
'Do whatever you like here...
MsgBox "You clicked on cell " & Selection.Address(0, 0)
End Function
Be sure to place this function in a STANDARD CODE MODULE.
That's it.
I've just founded a solution. If I refer my Inserted Hyperlink to some cell in other sheet and then make it very hidden (xlSheetVeryHidden), it works just perfect. Now my hyperlinks refer to the Neverland and the macro captures them as well. Thank you all for your patiense.
Good solution Excel Hero but not for everything: I try to make a kind of outline but it's impossible to hide a row in the function: nothing happen! But if a make a direct call to the same code with a button, everything works fine. This is my test:
Function test()
Set test = Selection
Dim i, j, state As Integer
state = Selection.Value
i = Selection.Row + 1
j = i
If state = "6" Then
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = True
Debug.Print "test group: " & i & ":" & j - 1
Else
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = False
Debug.Print "test ungroup: " & i & ":" & j - 1
End If
End Function
My debug.print give me this:
test group: 4:26
Select a group of cells and run:
Sub HyperAdder()
For Each r In Selection
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=r.Parent.Name & "!" & r.Address(0, 0), TextToDisplay:="myself"
Next r
End Sub
I have the following code
For x = LBound(arr) To UBound(arr)
sname = arr(x)
If instr(sname, "Configuration item") Then
'**(here i want to go to next x in loop and not complete the code below)**
'// other code to copy past and do various stuff
Next x
So I thought I could simply have the statement Then Next x, but this gives a "no for statement declared" error.
So what can I put after the If instr(sname, "Configuration item") Then to make it proceed to the next value for x?
You can use a GoTo:
Do
'... do stuff your loop will be doing
' skip to the end of the loop if necessary:
If <condition-to-go-to-next-iteration> Then GoTo ContinueLoop
'... do other stuff if the condition is not met
ContinueLoop:
Loop
You're thinking of a continue statement like Java's or Python's, but VBA has no such native statement, and you can't use VBA's Next like that.
You could achieve something like what you're trying to do using a GoTo statement instead, but really, GoTo should be reserved for cases where the alternatives are contrived and impractical.
In your case with a single "continue" condition, there's a really simple, clean, and readable alternative:
If Not InStr(sname, "Configuration item") Then
'// other code to copy paste and do various stuff
End If
For i=1 To 10
Do
'Do everything in here and
If I_Dont_Want_Finish_This_Loop Then
Exit Do
End If
'Of course, if I do want to finish it,
'I put more stuff here, and then...
Loop While False 'quit after one loop
Next i
A lot of years after... I like this one:
For x = LBound(arr) To UBound(arr): Do
sname = arr(x)
If instr(sname, "Configuration item") Then Exit Do
'// other code to copy past and do various stuff
Loop While False: Next x
A few years late, but here is another alternative.
For x = LBound(arr) To UBound(arr)
sname = arr(x)
If InStr(sname, "Configuration item") Then
'Do nothing here, which automatically go to the next iteration
Else
'Code to perform the required action
End If
Next x
And many years later :D I used a "select" statement for a simple example:
For Each zThisRow In zRowRange
zRowNum = zThisRow.Row
Select Case zRowNum
Case 1 '- Skip header row and any other rows to skip -----
'- no need to put anything here -----
Case Else '- Rows to process -----
'- Process for stuff to do something here -----
End Select
Next zThisRow
You can make this as complex as you wish by turning each "if" result into a value (maybe a bit of over complex code would help explain :D ):
zSkip = 0
If 'condition1 = skip' Then zSkip = zSkip + 1
If 'condition2 = skip' Then zSkip = zSkip + 1
If 'condition3 = skip' Then zSkip = zSkip + 1
Select Case zRowNum
Case 0 '- Stuff to do -----
Case Else '- Stuff to skip -----
End Select
It's just a suggestion; have a great Christmas peeps!
This can also be solved using a boolean.
For Each rngCol In rngAll.Columns
doCol = False '<==== Resets to False at top of each column
For Each cell In Selection
If cell.row = 1 Then
If thisColumnShouldBeProcessed Then doCol = True
End If
If doCol Then
'Do what you want to do to each cell in this column
End If
Next cell
Next rngCol
For example, here is the full example that:
(1) Identifies range of used cells on worksheet
(2) Loops through each column
(3) IF column title is an accepted title, Loops through all cells in the column
Sub HowToSkipForLoopIfConditionNotMet()
Dim rngCol, rngAll, cell As Range, cnt As Long, doCol, cellValType As Boolean
Set rngAll = Range("A1").CurrentRegion
'MsgBox R.Address(0, 0), , "All data"
cnt = 0
For Each rngCol In rngAll.Columns
rngCol.Select
doCol = False
For Each cell In Selection
If cell.row = 1 Then
If cell.Value = "AnAllowedColumnTitle" Then doCol = True
End If
If doCol Then '<============== THIS LINE ==========
cnt = cnt + 1
Debug.Print ("[" & cell.Value & "]" & " / " & cell.Address & " / " & cell.Column & " / " & cell.row)
If cnt > 5 Then End '<=== NOT NEEDED. Just prevents too much demo output.
End If
Next cell
Next rngCol
End Sub
Note: If you didn't immediately catch it, the line If docol Then is your inverted CONTINUE. That is, if doCol remains False, the script CONTINUES to the next cell and doesn't do anything.
Certainly not as fast/efficient as a proper continue or next for statement, but the end result is as close as I've been able to get.
you can do that by simple way, simply change the variable value that used in for loop to the end value as shown in example
Sub TEST_ONLY()
For i = 1 To 10
ActiveSheet.Cells(i, 1).Value = i
If i = 5 Then
i = 10
End If
Next i
End Sub
I sometimes do a double do loop:
Do
Do
If I_Don't_Want_to_Finish_This_Loop Then Exit Do
Exit Do
Loop
Loop Until Done
This avoids having "goto spaghetti"