hope someone can help me fix this code. Want to look for a string "StringName" in column F (the string will always be in column F). I have tried to make an array of the two sheets, and then loop through them and find the string i want to delete. If the string is found in one or both of the sheets, then the entire row should be deleted.
I want to do this with 4 more strings, and havent thought on how to do it yet. Would it be better to just find the strings i need to keep which is "hello" and "goodbye", and then say everything that doesn't match those two string, delete? Hope someone can help
Sub test1()
Dim sheetArray As Variant
Dim ws As Variant
Dim targetCell As Range
sheetArray = Array("Sheet1", "Sheet2")
For Each ws In sheetArray
With Worksheets(ws)
For Each targetCell In Range("F:F")
If InStr(targetCell, "StringName") Then
targetCell.EntireRow.delete
End If
Next targetCell
End With
Next ws
End Sub
Use If ... And ... or If ... Or ....
Example below, I went for just keeping 'hello' and 'goodbye' as you suggest because the code's shorter/simpler that way.
Sub answer1()
Dim sheetArray As Variant, ws As Worksheet, a As Long
sheetArray = Array(Worksheets("Sheet1"), Worksheets("Sheet2"))
For Each ws In sheetArray
With ws
For a = .UsedRange.Rows.Count + UsedRange.Row -1 to .UsedRange.Row step -1 'counting backwards/upwards because we're deleting rows, counting forward/down would end up skipping some rows.
If Not .Cells(a, 6) Like "*hello*" _
And Not .Cells(a, 6) Like "*goodbye*" Then 'the 6 refers to column F
.Rows(a).Delete
End If
Next
End With 'ws
Next ws
End Sub
I used autofilter and delete rows the visible rows. if there is no header, no need of offset. I used string doesn't match criteria in sheet1 and string match criteria in Sheet2 in the code
Sub autofilter_Remove()
Dim wb As Workbook
Dim ws1, ws2 As Worksheet
Dim Rng1, Rng2 As Range
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")
Set Rng1 = ws1.Rows(1)
Set Rng2 = ws2.Rows(1)
Stringname = "hello"
'6 for F column
Rng1.AutoFilter Field:=6, Criteria1:="<>*" & Stringname & "*"
ws1.UsedRange.Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
ws1.Cells.AutoFilter
Rng2.AutoFilter Field:=6, Criteria1:="*" & Stringname & "*"
ws2.UsedRange.Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
ws2.Cells.AutoFilter
End Sub
Related
I have a worksheet where Appt Note text is very lengthy. I need to place it in a row of nine merged cells.
I'm trying to check all the cells in column A for the value "Appt Note:" then merge the nine cells to the right of it so all my data shows up in a viewable format.
I checked lots of posts online but can't put my particular code together. I've built it, with the exception of the merge.
Sub MergeTest()
Dim cel As Range
Dim WS As Worksheet
For Each WS In Worksheets
For Each cel In WS.Range("$A1:$A15")
If InStr(1, cel.Value, "Appt Note:") > 0 Then Range(cel.Offset(1, 9)).Merge
Next
Next
End Sub
As per my comment, hereby a sample of Range.Find where in this case I assume "Appt Note:" only exists once per sheet:
Sub Test()
Dim ws As Worksheet
Dim cl As Range
For Each ws In ThisWorkbook.Worksheets
Set cl = ws.Range("A:A").Find(What:="Appt Note:", Lookat:=xlPart)
If Not cl Is Nothing Then
cl.Offset(0, 1).Resize(1, 9).Merge
End If
Next
End Sub
Note: Merged cells are VBA's worst nightmare! Try to stay away from them. Maybe you can let the text just overflow?
Edit: In case your value could exist multiple times, use Range.FindNext:
Sub Test()
Dim ws As Worksheet
Dim cl As Range
Dim rw As Long
For Each ws In ThisWorkbook.Worksheets
Set cl = ws.Range("A:A").Find(What:="Appt Note:", Lookat:=xlPart)
If Not cl Is Nothing Then
rw = cl.Row
Do
cl.Offset(0, 1).Resize(1, 9).Merge
Set cl = ws.Range("A:A").FindNext(cl)
If cl Is Nothing Then
GoTo DoneFinding
End If
Loop While cl.Row <> rw
End If
DoneFinding:
Next
End Sub
Sub MergeTest()
Dim ws As Worksheet, cell As Range
For Each ws In ThisWorkbook.Worksheets
For Each cell In ws.Range("A1:A15")
If cell.Value Like "Appt Note:*" Then cell.Resize(1, 9).Merge
Next
Next
End Sub
ThisWorkbook refers to the workbook where the VBA code is, to avoid issues when a different workbook is active. The Like operator can be used to check if the cell value matches a wildcard pattern.
cell.Resize(1, 9) can be used to get a new range starting from cell and resized to 9 columns.
I found code that will do what I need. See below. I've tested it and it works. It will start at the bottom of my spreadsheet and find the last row with data and work it's way up until it reaches my first row.
Thanks so much for all your help! If you have any suggestions, advice, warnings, etc regarding the code below, please share. As I said, I am completely new to VB and know just enough to be dangerous. So I can use all the help I can get. :)
Sub mergeCellsBasedOnCriteria()
Dim myFirstRow As Long
Dim myLastRow As Long
Dim myCriteriaColumn As Long
Dim myFirstColumn As Long
Dim myLastColumn As Long
Dim myWorksheet As Worksheet
Dim myCriteria As String
Dim iCounter As Long
myFirstRow = 1
myCriteriaColumn = 1
myFirstColumn = 2
myLastColumn = 10
myCriteria = "Appt Note:"
Set myWorksheet = Worksheets("Sample")
With myWorksheet
myLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For iCounter = myLastRow To myFirstRow Step -1
If .Cells(iCounter, myCriteriaColumn).Value = myCriteria Then
.Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter, myLastColumn)).Merge
.Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter, myLastColumn)).WrapText = True
End If
Next iCounter
End With
End Sub
I've got Workbook where I got names and hours worked of employees. I'm looking for comparing rows in one worksheet (Range B6:CC6) and find it in another with selection on cell with employee name (Range A1:A5000) when I change sheets from 1 to 2.
Tried some Range.Find and others, no idea how to do it
Public Sub FindPosition()
Dim Actcol As Integer, Pos As Range, Name As Range
Actcol = ActiveCell.Column
MsgBox "ActiveCell is" & Actcol
Set Pos = Cells(6, Actcol)
MsgBox Pos
Pos.Select
If Worksheets("Sheet2").Activate Then
Worksheets("Sheet2").Range("A1:AA5100").Select
Set Name = Selection.Find(Pos, LookIn:=xlValues)
End If
End Sub
First, if you want to trigger some macro by activation of Sheet2, you need to handle Activate event of Sheet2. This can be done by declaring subroutine in Sheet module like this.
Private Sub Worksheet_Activate()
'Codes you want to be run when Sheet2 is activated.
End Sub
Second, a simple way to find a cell with specific value is to use WorksheetFunction.Match. For example,
Dim SearchInRange As Range
Set SearchInRange = Range("A1:A5000")
Dim EmployeeName As Variant
EmployeeName = ... 'Actual employee name you want to search
On Error GoTo NotFound
Dim Index As Variant
Index = WorksheetFunction.Match(EmployeeName, SearchInRange, 0)
On Error GoTo 0
SearchInRange.Cells(Index).Select
GoTo Finally
NotFound:
' Handle error
Finally:
Range.Find may also work, but remember it has the side effect of changing the state of "Find and Replace" dialog box.
This may helps you
Option Explicit
Sub test()
Dim i As Long, LastRowA As Long, LastRowB As Long
Dim rngSearchValues As Range, rngSearchArea As Range
Dim ws1 As Worksheet, ws2 As Worksheet
'Set you worksheets
With ThisWorkbook
'Let say in this worksheet you have the names & hours
Set ws1 = .Worksheets("Sheet1")
'Let say in this worksheet you have the list of names
Set ws2 = .Worksheets("Sheet2")
End With
'Find the last row of the column B with the names from the sheet with names & hours
LastRowB = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
'Find the last row of the column A with the names from the sheet with list of names
LastRowA = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'Set the range where you want to check if the name appears in
Set rngSearchArea = ws2.Range("A1:A" & LastRowA)
'Loop the all the names from the sheet with names and hours
For i = 6 To LastRowB
If ws1.Range("B" & i).Value <> "" Then
If Application.WorksheetFunction.CountIf(rngSearchArea, "=" & ws1.Range("B" & i).Value) > 0 Then
MsgBox "Value appears"
Exit For
End If
End If
Next i
End Sub
Oh right, I found solution. Thanks everyone for help.
Public Sub Position()
Dim Accol As Integer
Dim Pos As Range
Dim name As Range
ActiveSheet.name = "Sheet1"
Accol = ActiveCell.Column
Set Pos = Cells(6, Accol)
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("a1:a5000").Select
Set name = Selection.Find(What:=Pos, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
name.Select
End Sub
Last thing I would like to do which I cannot solve is where do I write automatically script running when I choose Sheet2?
I am looking for a code to get the name of the last added sheet to Excel.
I have tried this...
Sub test()
Dim lastAddedSheet As Worksheet
Dim oneSheet As Worksheet
With ThisWorkbook
Set lastAddedSheet = .Sheets(1)
For Each oneSheet In .Sheets
If Val(Mid(oneSheet.CodeName, 6)) > Val(Mid(lastAddedSheet.CodeName, 6)) Then
Set lastAddedSheet = oneSheet
End If
Next oneSheet
End With
MsgBox lastAddedSheet.Name & " was last added."
End Sub
But it does not really work.
You can't reliably know what sheet was last added, because a sheet can be inserted before or after any existing sheet in a workbook, see Sheets.Add documentation.
Unless you're the one adding it. In which case, all you need to do is capture the Worksheet object returned by the Add method:
Dim newSheet As Worksheet
Set newSheet = wb.Worksheets.Add
Debug.Print newSheet.Name
Extracting the digits from the CodeName isn't going to be reliable either - especially if you assume that every sheet's code name begins with 5 letters. On a German machine, the CodeName of what we see as Sheet1 would be Tabelle1 - but then again the role of that digit is strictly to ensure uniqueness of the names of the VBComponent items in the VBA project, and none of it says it has anything to do with any sort of ordering.
As per #MathieuGuindon his answer, I can't think of any "simple" way to safely return the name of the latest added sheet. However if you willing to sacrifice some designated space in your project to store CodeNames you could try to utilize the Workbook_NewSheet event.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim lr As Long
With Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lr, 1) = ActiveSheet.CodeName
End With
End Sub
Obviously you need to optimize this to add names when adding sheets during runtime. In this simplified example I manually added the existing sheet "Blad1", and upon adding new sheets, the list grew.
When deleting you can utilize the SheetBeforeDelete event, like so:
Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
Dim ws As Object
Dim lr As Long, x As Long
Dim rng1 As Range, rng2 As Range, cl As Range
With Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Set rng1 = .Range("A2:A" & lr)
For Each ws In ActiveWindow.SelectedSheets
For Each cl In rng1
If cl = ws.CodeName Then
If Not rng2 Is Nothing Then
Set rng2 = Union(rng2, cl)
Else
Set rng2 = cl
End If
End If
Next cl
Next ws
End With
If Not rng2 Is Nothing Then
rng2.Delete
End If
End Sub
Now to get the latest added sheet we can refer to the last cell in our designated range:
Sub LastAdded()
Dim lr As Long
With ThisWorkbook.Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Debug.Print "Last added sheet is codenamed: " & .Cells(lr, 1)
End With
End Sub
My take on it is that it would be safest to use the CodeName since they are least likely to get changed and are unique. We can also safely keep using our rng variable since there will always be at least one worksheet in your project (and that might just be the designated one if you protect it). Working in this project will now keep track of latest added worksheet.
Sheets could be a Chart or a Worksheet.
You could try use Worksheets instead of Sheets in your code.
sub test()
Dim lastAddedSheet As Worksheet
Dim oneSheet As Worksheet
With ThisWorkbook
Set lastAddedSheet = .WorkSheets(1)
For Each oneSheet In .WorkSheets
If Val(Mid(oneSheet.CodeName, 6)) > Val(Mid(lastAddedSheet.CodeName, 6)) Then
Set lastAddedSheet = oneSheet
End If
Next oneSheet
End With
MsgBox lastAddedSheet.Name & " was last added."
End Sub
I have a spreadsheet that is updated regularly. Therefore the column header positions change regularly. eg. today "Username" is column K, but tomorrow "Username" might be column L. I need to add a new column to the right of "Username" but where it changes I cannot refer to as cell/column reference.
So far I have:
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find("Username")
When I go to add a new column to the right of it, I'm selecting that row but it's going back to cell/column references...
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "Role"
How can I perform this step with a macro?
edit: I think need to give that Column a header name and begin populating the row with data - each time I do begins the cell references which I want to avoid wherever possible.
Many thanks in advance.
How about:
Sub qwerty()
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find(what:="Username", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "role"
End Sub
Sub AddColumn
Dim cl as Range
For each cl in Range("1:1")
If cl = "username" Then
cl.EntireColumn.Insert Shift:= xlToRight
End If
cl.Offset(0, 1) = "role"
Next cl
End Sub
Untested code as not at my desktop
Something like this should work. The idea is that you locate the column and then you insert to the right. That is why you have the +1 in the TestMe. The function l_locate_value_col returns the column, where it has found the value. If you want, you may change the optional parameter l_row, depending on which row do you want to look for.
Option Explicit
Public Sub TestMe()
Dim lngColumn As Long
lngColumn = l_locate_value_col("Username", ActiveSheet)
Cells(1, lngColumn + 1).EntireColumn.Insert
End Sub
Public Function l_locate_value_col(target As String, _
ByRef target_sheet As Worksheet, _
Optional l_row As Long = 1)
Dim cell_to_find As Range
Dim r_local_range As Range
Dim my_cell As Range
Set r_local_range = target_sheet.Range(target_sheet.Cells(l_row, 1), target_sheet.Cells(l_row, Columns.Count))
For Each my_cell In r_local_range
If target = Trim(my_cell) Then
l_locate_value_col = my_cell.Column
Exit Function
End If
Next my_cell
l_locate_value_col = -1
End Function
You could name your range:
Sub Test()
Dim rngUsernameHeader As Range
'UserName is in column F at the moment.
Set rngUsernameHeader = Range("UserName")
Debug.Print rngUsernameHeader.Address 'Returns $F$1
ThisWorkbook.Worksheets("Sheet2").Range("E:E").Insert Shift:=xlToRight
Debug.Print rngUsernameHeader.Address 'Returns $G$1
End Sub
Edit:
Have rewritten so it inserts a column after your named column and returns that reference:
Sub Test()
Dim rngUsernameHeader As Range
Dim rngMyNewColumn As Range
Set rngUsernameHeader = Range("UserName")
rngUsernameHeader.Offset(, 1).Insert Shift:=xlToRight
'You'll need to check the named range doesn't exist first.
ThisWorkbook.Names.Add Name:="MyNewRange", _
RefersTo:="='" & rngUsernameHeader.Parent.Name & "'!" & _
rngUsernameHeader.Offset(, 1).Address
Set rngMyNewColumn = Range("MyNewRange")
MsgBox rngMyNewColumn.Address
End Sub
I have an excel workbook, in worksheet1 in Column A, IF the value of that column = ERR I want it to be deleted (the entire row), how is that possible?
PS: keep in mind that I have never used VBA or Macros before, so detailed description is much appreciated.
Using an autofilter either manually or with VBA (as below) is a very efficient way to remove rows
The code below
Works on the entire usedrange, ie will handle blanks
Can be readily adpated to other sheets by changing strSheets = Array(1, 4). ie this code currently runs on the first and fourth sheets
Option Explicit
Sub KillErr()
Dim ws As Worksheet
Dim lRow As Long
Dim lngCol As Long
Dim rng1 As Range
Dim strSheets()
Dim strws As Variant
strSheets = Array(1, 4)
For Each strws In strSheets
Set ws = Sheets(strws)
lRow = ws.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
lngCol = ws.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
Application.ScreenUpdating = False
ws.Rows(1).Insert
Set rng1 = ws.Range(ws.Cells(1, lngCol), ws.Cells(lRow + 1, lngCol))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=RC1=""ERR"""
.AutoFilter Field:=1, Criteria1:="TRUE"
.EntireRow.Delete
On Error Resume Next
.EntireColumn.Delete
On Error GoTo 0
End With
Next
Application.ScreenUpdating = True
End Sub
sub delete_err_rows()
Dim Wbk as Excel.workbook 'create excel workbook object
Dim Wsh as worksheet ' create excel worksheet object
Dim Last_row as long
Dim i as long
Set Wbk = Thisworkbook ' im using thisworkbook, assuming current workbook
' if you want any other workbook just give the name
' in invited comma as "workbook_name"
Set Wsh ="sheetname" ' give the sheet name here
Wbk.Wsh.activate
' it means Thisworkbook.sheets("sheetname").activate
' here the sheetname of thisworkbook is activated
' or if you want looping between sheets use thisworkbook.sheets(i).activate
' put it in loop , to loop through the worksheets
' use thisworkbook.worksheets.count to find number of sheets in workbook
Last_row = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row 'to find the lastrow of the activated sheet
For i = lastrow To 1 step -1
if activesheet.cells(i,"A").value = "yourDesiredvalue"
activesheet.cells(i,"A").select ' select the row
selection.entirerow.delete ' now delete the entire row
end if
Next i
end sub
Note any operations that you do using activesheet , will be affected on the currently activated sheet
As your saying your a begginner, why dont you record a macro and check out, Thats the greatest way to automate your process by seeing the background code
Just find the macros tab on the sheet and click record new macro , then select any one of the row and do what you wanted to do , say deleting the entire row, just delete the entire row and now go back to macros tab and click stop recording .
Now click alt+F11 , this would take you to the VBA editor there you find some worksheets and modules in the vba project explorer field , if you dont find it search it using the view tab of the VBA editor, Now click on module1 and see the recorded macro , you will find something like these
selection.entirerow.delete
I hope i helped you a bit , and if you need any more help please let me know, Thanks
Fastest method:
Sub DeleteUsingAutoFilter()
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = False
.Columns("A").AutoFilter Field:=1, Criteria1:="ERR"
.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
Second fastest method (lots of variations to this one too):
Sub DeleteWithFind()
Dim rFound As Range, rDelete As Range
Dim sAddress As String
Application.ScreenUpdating = False
With Columns("A")
Set rFound = .Find(What:="ERR", After:=.Resize(1, 1), SearchOrder:=xlByRows)
If Not rFound Is Nothing Then
Set rDelete = rFound
Do
Set rDelete = Union(rDelete, rFound)
Set rFound = .FindNext(rFound)
Loop While rFound.Row > rDelete.Row
End If
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
Autofilter method for multiple sheets:
Sub DeleteUsingAutoFilter()
Dim vSheets As Variant
Dim wsLoop As Worksheet
Application.ScreenUpdating = False
'// Define worksheet names here
vSheets = Array("Sheet1", "Sheet2")
For Each wsLoop In Sheets(vSheets)
With wsLoop
.AutoFilterMode = False
.Columns("A").AutoFilter Field:=1, Criteria1:="ERR"
.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Next wsLoop
Application.ScreenUpdating = True
End Sub
Assuming there are always values in the cells in column A and that the data is in the first sheet, then something like this should do what you want:
Sub deleteErrRows()
Dim rowIdx As Integer
rowIdx = 1
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
While ws.Cells(rowIdx, 1).Value <> ""
If ws.Cells(rowIdx, 1).Value = "ERR" Then
ws.Cells(rowIdx, 1).EntireRow.Delete
Else
rowIdx = rowIdx + 1
End If
Wend
End Sub