I have a problem with VBA in Excel 2007.
I need a macro to hide rows when a specific string is in a cell. (e.g. "System PPP cancelled")
My macro:
Sub HideRows()
Dim Cell As Range
If InStr(Cell, "cancelled") And Rows(Cell.Row).Hidden = False _
Then Rows(Cell.Row).Hidden = True
Next Cell
End Sub
Unfortunately, I get the runtime-error '13'...
Can you help me?
This works in Excel 2010:
Sub hide_cancelled()
For i = 1 To Rows.Count
If InStr(Cells(i, 2).value, "cancelled") And Rows(i).Hidden = False Then
Rows(i).Hidden = True
End If
Next i
End Sub
Note that this will iterate over ALL rows in the spreadsheet, no matter if they contain any data or completely empty. This may take a while! So instead of Rows.Count you should enter a more sane value.
Also this will expect the search value in column 2. Change this in Cells(i,xxx)
Related
first of all I'm not a VBA programmer but typically an end-user who uses snippets of code that I gather in forums like this in his spreadsheets, trying to understand what the code does. Code for which I thank you all!
My objective:
I have a spreadsheet that is basically an input-form for users.
Based on their input and selections via dropdown my intention is to guide them through the form by hiding & unhiding rows with input fields, presenting the users with the relevant questions.
On each row I have created an IF-formula that creates a 1 or 0 based on previous provided input
1 -> unhide the row , 0 -> hide the row.
So I'm looking for a macro that runs with every sheet calculation and hides or unhides the next rows as needed.
These formulas are in range I3:I70 on top of that I created a summary field in I2 =sum(I3:I70) so i thought I can either check changes in the range I3:I70 or changes on cell I2 to trigger the macro. [Neither solution fixed my problem]
I've tried several code examples discribed on the forums and I've tested the macros that checks for change in the range or the cell individually.
As long as I call a test macro with a MsgBox it works fine.
Also the macro that hides or unhides runs fine when I call it manually.
My problem:
When I let the 'auto'-macro call the 'hide'-macro, Excel simply crashes; no warnings, nothing --> just crash.
My code:
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("H3:H70")
If Not Intersect(Xrg, Range("H3:H70")) Is Nothing Then
Macro1
End If
End Sub
Sub Sample()
MsgBox "Yes"
End Sub
Sub Macro1()
Dim cell As Range
For Each cell In Range("H3:H70")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
If cell.Value = 1 Then
cell.EntireRow.Hidden = False
End If
End If
Next
End Sub
Thanks for any suggestions and tips in advance.
JeWe
Never give up searching :-) I gave it a last search and found some code on the microsfof dot com site that seems to work.
Don't ask me the details but this seems to do what i'm looking for
Private Sub Worksheet_Calculate()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
On Error Resume Next
For Each c In Range("H3:H70")
If c.Value = 0 Then
c.EntireRow.Hidden = True
ElseIf c.Value = 1 Then
c.EntireRow.Hidden = False
End If
Next
On Error GoTo 0
Application.EnableEvents = True
End Sub
It's late on my end of the world, going to sleep. Will update tomorrow.
Txs JeWe
I used the code from Siddharth Rout on the following thread to capitalize selected columns but ran into a Error '13' MISMATCH when I used it on a column with cells that had formulas in some of the range.
Excel VBA - Capitalizing all selected cells in column on double click
Here is the code that worked on non-formula based column data from the above link:
Sub ChangeToUpper()
Dim rng As Range
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
Set rng = Selection
rng = WorksheetFunction.Transpose(Split(UCase(Join( _
WorksheetFunction.Transpose(rng), vbBack)), vbBack))
End Sub
I searched the forums and didn't find specifics related to this. So I googled it and Mr.Excel had this code but still gave the Error '13', when I cleared out of the error message everything was capitalized. Is there a way to eliminate getting this error?
Here is the code from Mr.Excel:
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
If Len(cell) > 0 Then cell = UCase(cell)
Next cell
Application.ScreenUpdating = True
End Sub
Check If Cell has formula and or errors, If yes then ignore.
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
'/ Exclude errors
If Not IsError(cell) Then
If Len(cell) > 0 And Not cell.HasFormula Then
cell = UCase(cell)
End If
End If
Next cell
Application.ScreenUpdating = True
End Sub
In sheet1 (which I've Called "MainSheet") I have a sub in my VBA script that check the values of some cells whenever a cell is changed in this sheet. (one of the main actions that will occur when a cell is changed is modifying it's color, green for Cell's with a value, red for empty cells)
But now I've got some other sub's that also change cells (in the main sheet) but in this case I don't need (and don't want) VBA to check the cells and adapt the color to their values after every cell change. (annoying when editing a large amount of cells).
(I've already tried to put this sub in the "ThisWorkbook"part of VBA instead of the Sheet1(MainSheet) part, but unfortunately this made no difference at all).
Question one: is it possible to prevent this?
I also have a correlated problem with another sub that worth mentioning in the same question I think: In this sub a new sheet is created, named and filled with text from a .txt document. Then the sheet will be saved as new workbook, and the sheet will be deleted. (The name of the sheet equals the name it will get when it's saved, and varies ever new occurrence.)
When I'm copying the .txt lines into this sheet one by one, the first sub I mentioned (the one editing cell color) is called. one of the first things happening in this sub is calling my MainSheet. When thin sub is finished the line copying sub will continue but will start pasting the lines in my Main Sheet. I tried to enter lines in this sub that select the sheet with variable name, but it keeps jumping to the MainSheet.
Question two: How do I prevent jumping to the MainSheet?
(Both questions probably could have the same solution.)
The sub that modifies the cell colours:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Integer
'Collor all cells green containing values, collor empty cells red.
''Starts automaticly after every cell change within this sheet
'Huidige Cell onthouden
If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
On Error GoTo bm_Safe_Exit3
Application.EnableEvents = False
If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
Else
Dim newVal3 As Variant
newVal3 = Target.Value
Range("A9:A29").ClearContents
Target.Value = newVal3
End If
End If
bm_Safe_Exit3:
Application.EnableEvents = True
Set myActiveCell = ActiveCell
Set myActiveWorksheet = ActiveSheet
Set myActiveWorkbook = ActiveWorkbook
Sheets("MainSheet").Select
Range("C5").Select
j = 0
Do While j < 6
If ActiveCell.Offset(0, j).Value = "" Then
ActiveCell.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
Else: ActiveCell.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
End If
j = j + 1
Loop
'Terug naar de voormalig active cell
myActiveWorkbook.Activate
myActiveWorksheet.Activate
myActiveCell.Activate
End Sub
Using .Select and .Activate is inefficient at the best of times; in a Worksheet_Change event macro it can really foul the waters.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
'intentionally throw an error; no more code run; sent to bm_Safe_Exit
Err.Raise 0
Else
Dim newVal3 As Variant
newVal3 = Intersect(Target, Range("A9:A29")).Cells(1).Value
Range("A9:A29").ClearContents
Intersect(Target, Range("A9:A29")).Cells(1) = newVal3
End If
End If
Dim j As Integer
With Worksheets("MainSheet").Range("C5")
For j = 0 To 6
If Not CBool(Len(.Offset(0, j).Value)) Then
.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
Else
.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
End If
Next j
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
It isn't clear exactly what worksheet this is running under; I hope it isn't the MainSheet as I've used direct referencing to the cells on that worksheet.
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
I'm working on a VBA project to automate the Excel tool for a service desk queries tracker. I want, once the command button is clicked, to copy the content from a textbox to another worksheet row. If I repeat the task, the textbox content should be saved in the next empty cell of the same row.
I used this macro:
Private Sub CommandButton1_Click()
TextBox1.Text = ""
TextBox1.Copy
'TextBox2.Copy
'TextBox3.Copy
Range("A2").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
End Sub
You really only need one line of code in your sub:
Private Sub CommandButton1_Click()
Range("A2").End(xlDown).Offset(1, 0).Value = TextBox1.Text
End Sub
Even though you don't say so, it looks like you want the textbox to be cleared as well. If so, then add TextBox1.Text = "" one line before End Sub.
I have a template file that I want to protect so that users cannot modify formulas. As the sheet is protected, I have written a macro to allow the user to insert rows. I also want a macro to allow the user to delete rows, but I want to prevent the user from deleting certain critical rows (e.g. check totals and headings, etc.).
To this end I have used column L in my template to identify rows that cannot be deleted. For these rows I have the word "keep" in that row of column L. I have written a basic delete macro below but I need to modify it to look in column L of the selected range rRange and Exit Sub if the word "keep" is there.
*Note that rRange could contain a number of adjacent rows so the macro would need to exit if any of those rows fail the test.
Sub DeteteRows()
Dim rRange As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please use mouse to select a row to Delete.", _
Title:="SPECIFY ROW TO DELETE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
Else
rRange.EntireRow.Delete
Range("a1").Select
MsgBox ("Row(s) Deteted")
End If
End Sub
This may not be the best way but it is below. I did not add the delete portion in the last if then else as I figured you can handle that
Sub DeteteRows()
Dim rRange As Range
Dim bKeepFound As Boolean
bKeepFound = False
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please use mouse to select a row to Delete.", _
Title:="SPECIFY ROW TO DELETE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
'dont need the else statement cause you exit the sub if it fails
End If
For Each Row In rRange.Rows
Dim s 'variable to hold the array
s = Split(Row.Address, ":") 'split out the column and row
'remove the $ and convert to a number then check the cell value
If rRange.Cells(CInt(Replace(s(0), "$", "")), 12).Value = "keep" Then
bKeepFound = True
End If
Next Row
'check to see if a row was found to keep
If bKeepFound Then
Exit Sub 'row was found so exit sub
Else
'delete the rows in the range
End If
End Sub