I have code to delete a checkbox in a certain cell but I need it to delete all checkboxes in a range I have selected. Following is the code I have that deletes a checkbox in a certain cell.
Columns("B:B").Select
Selection.Find(What:="FIELD SERVICES", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, -1).Select
Dim CB8 As CheckBox
For Each CB8 In ActiveSheet.CheckBoxes
If CB8.TopLeftCell.Address = ActiveCell.Address Then CB8.Delete
Next
Following is how I tried to alter it to delete cells in the range I need but it only deletes the checkbox in the first cell of the range.
Columns("B:B").Select
Selection.Find(What:="FIELD SERVICES", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range(ActiveCell.Offset(1, -1), ActiveCell.Offset(8, 0).Select
Dim CB8 As CheckBox
For Each CB8 In ActiveSheet.CheckBoxes
If CB8.TopLeftCell.Address = ActiveCell.Address Then CB8.Delete
Next
Any advice is greatly appreciated.
Dim f as Range, cbRange as range
Dim CB8 As CheckBox
Set f = Columns("B:B").Find(What:="FIELD SERVICES", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart)
if not f is Nothing then
set cbRange = f.parent.range(f.Offset(1, -1), f.Offset(8, 0))
For Each CB8 In ActiveSheet.CheckBoxes
If not application.intersect(CB8.TopLeftCell, cbRange) is nothing Then CB8.Delete
Next
end if
Related
Column A to H has data with some blanks in between. I want to find "ABC" in column A and then select 2 rows above - this will be my ActiveCell.
I want to delete rows in between ActiveCell to Row2 (Active Cell is Dynamic)
Sub format()
Cells.Find(What:="abc", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:= xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Select
Range(Selection, ActiveCell, A2).Select
End Sub
The code will do the job for you:
Sub format()
Dim rng As Range
Set rng = Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Offset(-2, 0).Select
Range(Cells(Selection.Row, 1), Cells(2, 1)).Select
'Selection.EntireRow.Delete
End Sub
Currently I have commented out the last line which will delete the Rows you want. uncomment it, but first be sure that's what you want to delete.
For Range please try:
(ActiveCell, "A2").Select
I need to find a text string and store the item names below the text string to put in a different location in the sheet
Example I want to find "Description" and store all the items below it to use later in the macro
And place them in B1 for example
Here's the code im trying to use but I don't know how to store the Active Range
Sub test()
'find description
Cells.Find(What:="Description", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.Offset(1, 0).Select 'Offset after find
Range(Selection, Selection.End(xlDown)).Select 'Selects to end
Dim DescriptionValues As Range
DescriptionValues = Active.Range
ActiveSheet.Range("B10") = DescriptionValues 'put stored text starting in B1
End Sub
Sub test()
Dim rng As Range
Set rng = ActiveSheet.Cells.Find(What:="Description", After:=ActiveSheet.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rng Is Nothing Then
Set rng = ActiveSheet.Range(rng.Offset(1, 0), rng.End(xlDown))
ActiveSheet.Range("B1").Resize(rng.Rows, 1).Value = rng.Value 'put stored text starting in B1
End If
End Sub
I'm working with hourly weather data in Excel that has each hour of every day of the year along with the corresponding temperature value that was recorded.
Some of the values weren't recorded, and instead show up as just an "M" on the spreadsheet. For example, A32 = 28, A33 = M, A34 = 30. I want to replace that "M" with a formula to take the average of the previous and next values. I know how to do this manually, but I am having difficulty writing a Macro to find all the M's in the spreadsheet, then auto-replace it as stated above.
My main obstacle is getting excel to use the correct values when replacing the "M".
Here is my code
Sub MReplace()
'
' MReplace Macro
'
'
ActiveCell.Select
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(-8, 1).Range("A1").Select
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Replace What:="M", Replacement:="[****This is what I am having difficulty with****]", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False).Activate
End Sub
I have heard of something that you can put in to the code that can address the selected cell. I think it's cell() but I am not sure. Maybe that is a way to get it to work better?
Try this code:
Sub MReplace()
Dim ws As Worksheet
Dim cel As Range
Dim firstAddress As String
Set ws = ActiveSheet
Set cel = ws.Range("A:A").Find("M")
If Not cel Is Nothing Then
firstAddress = cel.Address
Do
cel.Value = (cel.Offset(1) + cel.Offset( -1)) / 2
Set cel = ws.Range("A:A").FindNext(cel)
hr = False
If Not cel Is Nothing Then
If cel.Address <> firstAddress Then
hr = True
End If
End If
Loop While hr
End If
End Sub
It loops through all the cells containing "M" and replaces it with the average of the one on the right and the one on the left. It will error on any that are in the first column as there is no column to the left.
i look for a Code in VBA to look after Strings (called "Setup") in sheet2 and copy the String under "Setup" into sheet1 in cell A1.
I have a not working code from a recorded macro:
Sub FindString()
Cells.Find(What:="Setup", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("I8").Select
Selection.Copy
Sheets("Tabelle1").Select
ActiveSheet.Paste
End Sub
If i change that String, it Shows me error 91...
Try this
Sub FindString()
Sheets("Sheet2").Activate
Cells.Find(What:="Setup", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
'--------------------------------------------------------------------------------------
' Specify the string to find in sheet1 B1 cell
Sub FindString2()
Sheets("Sheet2").Activate
Cells.Find(What:=Sheets("Sheet1").Range("B1").Value, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Similar to #Punith's answer, except you don't need to change sheets.
Option Explicit
Sub find_string()
Const strLookup As String = "Setup"
Dim wb As Workbook, find_ws As Worksheet, to_ws As Worksheet, rngFound As Range
Set wb = ThisWorkbook
Set find_ws = wb.Sheets("find")
Set to_ws = wb.Sheets("to")
Set rngFound = find_ws.Cells.Find(What:=strLookup, LookIn:=xlValues, LookAt:=xlWhole).Offset(1, 0)
to_ws.Range("A1").Value = rngFound.Value
End Sub
I am trying to build a macro that will search a specific column.
Here are the steps:
1. user enters a number into the cell and then executes the macro.
2. based on the value of what the user has entered, the macro will find the text in a column.
I got everything to work pretty well except I don't know how to define the value of the cell that the user enters. Any help here would be appreciated.
Sheets("New Version ").Select
Range("B4").Select
Sheets("PN_List").Select
Columns("I:I").Select
'below is where I struggle
Selection.Find(What:=(""), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Let's say the user enters a number into cell B4, then you just have to adjust your code into:
Selection.Find(What:=Range("B4").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
You can do this in 2 ways.
Number1:
Module based: (code in module)
Sub Sample()
Dim search_range as Range, search_value as Range, _
lastcell as Range, foundcell as Range
Dim ws as Worksheet
Set ws = Thisworkbook.Sheets("PN_List")
Set search_range = ws.Range("I1", ws.Range("I" & Rows.Count).End(xlUp))
Set lastcell = search_range.Cells(search_range.Cells.Count)
Set search_value = Thisworkbook.Sheets("New Version").Range("B4")
Set foundcell = search_range.Find(What:=search_value, After:=lastcell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If Not foundcell Is Nothing Then foundcell.Activate Else Msgbox "Not Found"
End Sub
Number2:
Worksheet Event based. (code in Sheet)
Private Sub Worksheet_Change(ByVal Target as Range)
Dim search_range as Range, search_value as Range, _
lastcell as Range, foundcell as Range
Dim ws as Worksheet
Set ws = Thisworkbook.Sheets("PN_List")
Set search_range = ws.Range("I1", ws.Range("I" & Rows.Count).End(xlUp))
Set lastcell = search_range.Cells(search_range.Cells.Count)
Set search_value = Thisworkbook.Sheets("New Version").Range("B4")
If Not Intersect(Target, search_value) Is Nothing Then
query = Msgbox("Search data?", vbYesNo)
If query = 7 Then Exit Sub
Set foundcell = search_range.Find(What:=search_value, After:=lastcell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If Not foundcell Is Nothing Then foundcell.Activate Else Msgbox "Not Found"
End Sub
The first one you enter data in B4 then run the macro.
The second one fires every time you change value in B4.
A msgbox will appear asking if you want to search the data entered.
Hope this helps.