I simply try to write a search macro in an excel sheet. How can I start a macro dynamically DURING editing a cell. When writing in a cell the search macro should run in the background with every character added or deleted not just at the end.
Worksheet_Change(ByVal Target As Range) only starts when editing is finished (return was hit or other cell was selected).
Thanks.
You can't. The code engine won't run while Excel is in Edit mode. You have to have the user enter the text in something other than a cell - like a control on the worksheet or a control on a userform.
Thanks to Dick Kusleika for answering my question and to put me on the right track.
Here is the final solution for anybody having similar demands. It basically works with an ActiveX TextBox to enter the search-string. The macro than is looking in the search-area for all entries containing the search-string. All other filled rows within the search-field will get hidden. This works right away when writing into the TextBox. So, when deleting characters in the search-string the once hidden rows will appear right away if appropriate.
Private Sub TextBox1_Change()
Dim searchArea As Range, searchRow As Range, searchCell As Range
Dim searchString As String
Dim lastRow As Integer
Application.ScreenUpdating = False
searchString = "*" & LCase(TextBox1.Value) & "*"
' unhide rows to have the full search field when editing
Rows.Hidden = False
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set searchArea = Me.Range("A5", "A" & lastRow) 'Me.Range("A5").End(xlDown))
searchArea.EntireRow.Hidden = True
For Each searchRow In searchArea.Rows
For Each searchCell In searchRow.Cells
If LCase(searchCell) Like searchString Then
searchRow.Hidden = False
Exit For
End If
Next searchCell
Next searchRow
Application.Goto Cells(1), True
Application.ScreenUpdating = True
End Sub
works like a charm.
Related
Some logic to my process:
In column K on my worksheet I have inserted check boxes from cell K3 - K53 (this could become longer in the future) using the developer tab.
I then associated the check box with the same cell it is placed in.
I formatted the cells in this column by going to 'Format Cells', clicking on 'Custom' then typing in ';;;'. This was to HIDE the 'True/False' text from view.
My next step is to change the cell colour based on the text.
Note:
I have searched through a few forums and combined some code samples from them all, so I will not be able to reference the sources exactly, but below is what I have so far:
Code:
Sub Change_Cell_Colour()
Dim xName As Integer
Dim xChk As CheckBox
Dim rng As Range
Dim lRow As Long
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ActiveWorksheet.Range("K2:K" & lRow)
For Each xChk In ActiveSheet.CheckBoxes
xName = Right(xChk.Name, Len(xChk.Name) - 10)
If (Range(xChk.LinkedCell) = "True") Then
rng.Interior.ColorIndex = 6
Else
rng.Interior.ColorIndex = xlNone
End If
Next
End Sub
I keep getting an error on the line where I try to get the last row.
Code:
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Error:
Object Required
I am not even sure if the code I have will solve my issue, so any help solving the main issue highlighting a cell based on the check box being checked or not, will be greatly appreciated.
Here's a quick rewrite with LOTS of comments explaining:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Be explicit about which worksheet. Leaving it to "Activeworksheet" is going to cause problems
' as we aren't always sure which sheet is active...
'Also in this case we don't need to know the last row. We will iterate checkbox objects, not
' populate rows.
'lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
'Again... we don't need this. We just need to iterate all the checkboxes on the sheet
'Set rng = ActiveWorksheet.Range("K2:K" & lRow)
'This is good stuff right here, just change the ActiveSheet to something more explicit
' I've changed this to the tab named "Sheet1" for instance.
For Each xChk In Sheets("Sheet1").CheckBoxes
'Getting the name of the checkbox (but only the last 10 characters)
xName = Right(xChk.Name, Len(xChk.Name) - 10)
'We can check the linked cell's value, but we can also just check if the
' if the checkbox is checked... wouldn't that be easier?
'If (Range(xChk.LinkedCell) = "True") Then
If xChk.Value = 1 Then
'Now we can use the "LinkedCell", but it's a STRING not a RANGE, so we will have
' to treat it as the string name of a range to use it properly
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
Here's the barebones version just to get it working
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Loop through each checkbox in Sheet1. Set it to color 6 if true, otherwise no color
For Each xChk In Sheets("Sheet1").CheckBoxes
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
I'm totally assuming here, but I would imagine you want this macro to fire when a checkbox is clicked. There is a handy Application.Caller that holds the name of the object that caused a macro to be called. You can set the "Assign Macro.." of each checkbox to this new code and then you can figure out which checkbox called the subroutine/macro using application.caller and follow the same logic to toggle it's linked cell color:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Who called this subroutine/macro?
Dim clickedCheckbox As String
clickedCheckbox = Application.Caller
'Lets check just this checkbox
Set xChk = Sheets("Sheet1").CheckBoxes(clickedCheckbox)
'toggle its color or colour if you are a neighbour
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
End Sub
highlighting a cell based on the check box being checked or not
Select the sheet and apply a CF formula rule of:
=A1=TRUE
ActiveWorksheet doesn't exist, and because you haven't specified Option Explicit at the top of your module, VBA happily considers it an on-the-spot Variant variable.
Except, a Variant created on-the-spot doesn't have a subtype, so it's Variant/Empty.
And ActiveWorksheet.Cells being syntactically a member call, VBA understands it as such - so ActiveWorksheet must therefore be an object - but it's a Variant/Empty, hence, object required: the call is illegal unless ActiveWorksheet is an actual Worksheet object reference.
Specify Option Explicit at the top of the module. Declare all variables.
Then change ActiveWorksheet for ActiveSheet.
I once built a VBA button to automatically lock all cells with data in them. And it was working perfectly. Now I wanted to copy that button to another worksheet. So I created another button, copy and pasted the whole VBA over, then edited the worksheet names and range. And, it's only working like 5% of the time, the rest of the time, I'm getting an "Run-Time error '1004': No cells were found." I've tried a few fixed, changing Sheets to Worksheets, or adding a ", 23" to the specialcells argument. However, nothing is working right now. When I try stepping in, it sometimes say both rng and lckrng as empty, and sometimes only show lockrng as empty and not show rng at all. Problem is this used to be a working code, and now, it still works around 5% of time. Any idea why? Thank you very much!
Private Sub CommandButton1_Click()
Dim rng As Range
Dim lockrng As Range
Sheets("Uploading Checklist (M)").Unprotect Password:="signature"
Set rng = Range("A1:M14")
'Selecting hardcoded data and formulas
Set lockrng = Union(rng.SpecialCells(xlCellTypeConstants), rng.SpecialCells(xlCellTypeFormulas))
lockrng.Locked = True
Sheets("Uploading Checklist (M)").Protect Password:="signature"
End Sub
Maybe this is too simplistic, but it seems to do what you want. The animated .gif shows it working to "lock all cells with data in them". (I made the second button just for convenience). If nothing else it might be good to start from something like this that works and modify to suit your needs.
Dim cell As Range, sh As Worksheet
Sub Button4_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
For Each cell In sh.UsedRange
If cell <> "" Then cell.Locked = True Else cell.Locked = False
Next
sh.Protect Password:="s"
End Sub
Sub Button5_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
End Sub
The Union you are attempting will not work if either of the parameters is Nothing (i.e. you either have no constants in the range, or you have no formulas in the range).
Prior to doing the Union, you should check the parameters aren't Nothing but, once you start changing your code to do that, it would be just as simple to do the locking in two parts - so I recommend you rewrite the code as follows:
Private Sub CommandButton1_Click()
With Sheets("Uploading Checklist (M)")
.Unprotect Password:="signature"
With .Range("A1:M14")
'Lock any constants
If Not .SpecialCells(xlCellTypeConstants) Is Nothing Then
.SpecialCells(xlCellTypeConstants).Locked = True
End If
'Lock any formulas
If Not .SpecialCells(xlCellTypeFormulas) Is Nothing Then
.SpecialCells(xlCellTypeFormulas).Locked = True
End If
End With
.Protect Password:="signature"
End With
End Sub
I have a worksheet on Excel in which the user must input some registration numbers in column C. These numbers are usually inserted by the user by copying a pasting several of them at a time. The format of the copy source is often in the format "000.000.000-00", but I want it to be just "00000000000" in the worksheet, without the dots and dash.
I am trying to develop a code in Excel VBA to automatically remove these dots and dash after the user types or paste the registration number. I need it to be in the same cell. The code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SkipEvents As Boolean
If SkipEvents Then Exit Sub
With ActiveWorkbook.Sheets("Staff")
If Not Application.Intersect(Target, Me.Range("C:C")) Is Nothing Then
SkipEvents = True
li = Intersect(Target, Range("C:C")).Row
nl = Intersect(Target, Range("C:C")).Rows.Count
lf = li + nl - 1
For i = li To lf
RegNumb = Range("C" & i).Value
If Len(RegNumb) = 14 Then
Range("C" & i).Value = Left(RegNumb, 3) & Mid(RegNumb, 5, 3) & Mid(RegNumb, 9, 3) & Right(RegNumb, 2)
End If
Next i
SkipEvents = False
End If
End With
End Sub
So far, the code is able to remove the dots and dash if the user types or copy+paste one registration number at a time. However, when the user copy+paste 2 or more registraton numbers at a time, only the first cell from the range have its dots and dash removed, and the others stay as they are. Can someone help me with this problem?
Only the first cell in the range is being changed by your code because you are not iterating over the range. You could instead do this:
For each c in Target
if c.column = 3 then
c.value = Replace(Replace(c.value, ".", ""), "-", "")
end if
Next c
inside your Worksheet_Change.
You can replace directly on the entire desired range. You'll also need to Disable Events from firing since the changes you make will again fire the code. Also, since it's sheet level code, no need to refer to the sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCheck as Range
Set rCheck = Application.Intersect(Target, Me.Range("C:C"))
If Not rCheck is Nothing
Application.EnableEvents = False
rCheck.Replace(".","",lookat:=xlPart)
rCheck.Replace("-","",lookat:=xlPart)
Application.EnableEvents = True
End If
End Sub
I will also warn that if the data set being checked is very large, this replace method can have poor performance. However, if copy / paste is relatively small in terms of cell counts, it should be fine.
I am creating a userform that I want to be able to populate values in a data tab as well as default to certain values.
I think I have text boxes and combo boxes down, but cannot find info on using multiple optional buttons to generate data to one cell depending on the selection.
from the example, my criteria would be "secondary insurance" how do I go about linking them all so that, lets say cell b1 is populated with the selected option?
I'm completely guessing but I think checkboxes are a little more simple, true if checked and false if unchecked.
What I have so far is just a code I came across to fill in a cell with the value of the designated text/combo box and was just going to repeat for each column I need to set a criteria for.
Private Sub CommandButton1_Click()
Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
ws.Range("A" & LastRow).Value = TextBox1.Text 'Adds the TextBox1 into Col A & Last Blank Row
Me.Hide
End Sub
combobox list
Private Sub UserForm_Initialize()
ComboBox1.Value = ("N/A")
ComboBox1.List = Split("N/A Yes No")
End Sub
Please let me know if I lack information and or how to attach my test worksheet, hopefully you can see the picture (I can't on my work server).
Thanks in advance for any and all education.
If the caption of the option button is the same as you want as cell text, then something like this may be what you want to store it:
Private Sub CommandButton1_Click()
Dim LastRow As Range
With Sheets("Sheet1")
Set LastRow = .Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1).Cells
If OptionButton1 Then
LastRow(2).Value2 = Me.OptionButton1.Caption
ElseIf Me.OptionButton2 Then
LastRow(2).Value2 = Me.OptionButton2.Caption
Else
LastRow(2).Value2 = Me.OptionButton3.Caption
End If
End With
End Sub
This will set the desired cell to the value of the caption of the option button you have selected.
To load the data back in the userform, you could use something like this:
Sub Load_in(Row_To_Load As Long)
Dim MyRow As Range
With Sheets("Sheet1")
Set MyRow = .Rows(Row_To_Load).Cells
If MyRow(2).Value2 = OptionButton1.Caption Then
OptionButton1.Value = True
ElseIf MyRow(2).Value2 = OptionButton2.Caption Then
OptionButton2.Value = True
Else
OptionButton3.Value = True
End If
End With
End Sub
For this, I assumed that the names hasn't been changed. Also if nothing is selected, the third option (N/A) will be used. The same goes for loading it back. If you do not want that, simply change the Else part to ElseIf so it looks like the first 2 options.
I am working on an Excel macro (button) that will add a column into the same spot in multiple worksheets. Also, this column must have a column header that is input through a dialog box.
Each worksheet contains a table formatted the exact same way - the only difference is the worksheet names.
Here is what I have so far:
Sub CommandButton2_Click()
Sheets(Array("Sheet1", "Sheet2")).Select
Sheets("Sheet2").Activate
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightOrBelow
Dim myValue As Variant
myValue = InputBox("Enter Thought Leadership Title", "New Thought Leadership", "XXXXX")
Sheets(Array("Sheet1", "Sheet2”)).Select
Range("F5").Value = myValue
End Sub
This has gotten me exactly what I want for 'Sheet1' - adds a column (F) and inputs a header name specified through the dialog box into cell F5 while copying the formatting from the column immediately to the right. However, all it does for Sheet2 (and all others, but removed them for brevity) is add in a column without copying formatting from the right or adding the text specified through the dialog box.
Beginner VBA "programmer" and have gotten this far through using the forums here.
Hopefully I was clear - thanks for any input.
Just loop through Array("Sheet1", "Sheet2"). Adding the Type:=2 parameter to the InputBox will ensure that myValue will always be a string. If the user cancels the InputBox then myValue = "".
Sub CommandButton2_Click()
Dim ws
Dim myValue As Variant
myValue = Application.InputBox(Prompt:="Enter Thought Leadership Title", Title:="New Thought Leadership", Default:="XXXXX", Type:=2)
If myValue <> "" Then
For Each ws In Array("Sheet1", "Sheet2")
With ws
.Columns("F:F").Insert Shift:=xlToRight
.Range("F5").Value = myValue
End With
Next
End If
End Sub
An alternative to #ThomasInzina is this:
Sub commandButton2_Click_Test()
Dim myValue As Variant
For Each Worksheet In ActiveWorkbook.Worksheets
With Worksheet
.Range("F:F").EntireColumn.Insert shift:=xlToRight, copyOrigin:=xlFormatFromRightOrBelow
myValue = InputBox("Enter Thought Leadership Title", "New Thought Leadership", "XXXXX")
End With
Next Worksheet
Worksheets("Sheet1").Range("F5").Value = myValue ' I'm not sure where you wanted this,
Worksheets("Sheet2").Range("F5").Value = myvalue ' or what it does, so tweak as necessary.
End Sub
I tried to keep it as similar to your code as possible, while avoiding .Select (as mentioned in my comment below OP).
Note: This will loop through all worksheets in your workbook. You can add a line If worksheet.name = "Sheet1" or worksheet.name = "Sheet2" to only run it on those.