I am trying to do something simple. From column N in Log Frame info copy only unique values starting at B62 of Dropdown - this part works! Then, if one of the values in B62:B80 is "other" delete that cell - this part works sometimes and not others, can't tell why. Help!
Sub test()
Dim RngDest As Range
Dim Rng As Range, Cell As Range
Sheets("Dropdowns").Range("b61:b80").ClearContents
Set Rng = Sheets("Log Frame Info").Range("N4:N500")
Set RngDest = Sheets("Dropdowns").Range("B62")
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=RngDest, Unique:=True
With Sheets("Dropdowns")
Set Rng = Range("B61:b80")
For Each Cell In Rng
If Cell = "Other" Then
Cell.Delete
End If
Next Cell
End With
End Sub
The reason is because once a cell has been deleted, the For loop is continuing to the next cell rather than evaluating the new value of the cell. Something like this should work as it counts when a cell has been deleted and offsets the If call:
Sub test()
Dim RngDest As Range
Dim Rng As Range, Cell As Range
Dim i As Integer
Sheets("Dropdowns").Range("b61:b80").ClearContents
Set Rng = Sheets("Log Frame Info").Range("N4:N500")
Set RngDest = Sheets("Dropdowns").Range("B62")
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=RngDest, Unique:=True
With Sheets("Dropdowns")
Set Rng = Range("B61:b80")
For Each Cell In Rng
If Cell.Offset(-i, 0) = "Other" Then
Cell.Delete
i = i + 1
End If
Next Cell
End With
End Sub
Related
the aim of my problem is to find a specific value (Text) and then refer to the entire row (or even better only the used range to the right of my active cell) in a For/Each loop.
The first part works fine of finding my value, however, the code for targeting the row of the active cell (so the cell found by the find function), does not work yet:
Sub Search()
Dim cell As Range
Dim Count As Long
Set cell = Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
For Each cell In ActiveCell.EntireRow
If cell.Value = "0" Then
Count = Count + 1
End If
Next cell
Range("I1").Value = Count
End Sub
The following code will find the range to the right of your found cell and use your loop to do the comparision for each cell in the range. That part could probably be improved by using WorksheetFunction.CountIf.
Option Explicit
Sub Search()
Dim wks As Worksheet
Set wks = ActiveSheet
Dim cell As Range, sngCell As Range
Dim Count As Long
Set cell = wks.Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
If cell Is Nothing Then Exit Sub ' just stop in case no hit
Dim rg As Range, lastColumn As Long
With wks
lastColumn = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column ' last used column in cell.row
Set rg = Range(cell, .Cells(cell.Row, lastColumn)) ' used rg right from found cell inlcuding found cell
End With
' loop from the original post
For Each sngCell In rg
If sngCell.Value = "0" Then
Count = Count + 1
End If
Next
Range("I1").Value = Count
End Sub
I am trying to highlight empty cells in columns K,L,M.
I tried the below code
Sub highlight()
Dim myRange As Range, cel As Range
Set myRange = Sheet1.Range("K:M")
For Each cel In myRange
If Trim(cel.Value) = "" Then cel.Interior.ColorIndex = 3
Next cel
End Sub
Looking to highlight all the empty cells.
Try:
Sub Color_blank_cells()
'declare variables
Dim ws As Worksheet
Dim ColorRng As Range
Set ws = Worksheets("WorksheetName")
Set ColorRng = ws.Range("B3:C9")
'color blank cells'
ColorRng.SpecialCells(xlCellTypeBlanks).Interior.Color = RGB(220, 230, 241)
End Sub
Your code appears to work fine, it highlights all the empty cells red. The problem is that you have no way to break out of your loop when you reach the end of your data, the code will continue to highlight empty cells all the way to the end of the sheet (to row 1,048,576) which will likely cause Excel to hang.
You could find the last row of data and break out of the loop when this row is reached. The below limits the loop to the length of column "K" (assumes all columns have the same length).
Sub highlight()
Dim myRange As Range, cel As Range
Set myRange = Sheet1.Range("K:M")
n = Sheets("Sheet1").Range("K" & Sheets("Sheet1").Rows.Count).End(xlUp).Row
For Each cel In myRange
If cel.Row > n Then Exit For
If Trim(cel.Value) = "" Then cel.Interior.ColorIndex = 3
Next cel
End Sub
I'm trying to figure out a dynamic range that will select a range starting from the active cell in a for each loop. For instance, if cell A2 is selected in my for each cell loop, the range in the loop being A2:A20, and it contains "IP," it will select the range A2:M2, delete the contents, and shift all the values below, A3:M20, up to fill the emptied cells.
Sub deletewirelessdevice()
Dim rng As Range
Dim wksSource As Worksheet
Set wksSource = ActiveWorkbook.Sheets("dt-attext")
Set rng = wksSource.Range("A2:A500")
For Each Cell In rng
If InStr(1, ActiveSheet.Range(ActiveCell).Value, "IP") > 0 Then
Range(ActiveCell, "M" & ActiveCell.Row).Select.Delete Shift:=xlUp
Next Cell
End Sub
I'm not sure if there is a mistake in the selection and deletion as I can't get the code to run due to a Next without for compile error. There is a matching for so I don't know what the problem is. Any advice is welcome.
You had a number of issues with your code so I've tweaked it and inferred what you intended. This should work, however do read the comments above as well for some pointers on how to handle it next time
Public Sub deletewirelessdevice()
Dim DelRng As Range
Dim ColOffset As Long
With ActiveWorkbook.Sheets("dt-attext")
ColOffset = Range("M" & 1).Column - 1
For Each cell In .Range("A2:A500")
If InStr(cell.Value2, "IP") Then
If DelRng Is Nothing Then
Set DelRng = Range(cell, cell.Offset(0, ColOffset))
Else
Set DelRng = Union(DelRng, Range(cell, cell.Offset(0, ColOffset)))
End If
End If
Next cell
If Not DelRng Is Nothing Then DelRng.Delete Shift:=xlUp
End With
End Sub
I am using the following code to clean all cells dose not containing a formula.
Sub DoNotContainClearCells()
Dim rng As Range
Dim cell As Range
Dim ContainWord As String
'What range ?
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
'What I am looking for?
ContainWord = "="
For Each cell In rng.Cells
If cell.Find(ContainWord) Is Nothing Then cell.Clear
Next cell
End Sub
But I get the run time error 1004 and just the first column is removed. How can I treat this error? Is there any better way to delete cells from a sheet which dose not contain a formula?
Consider:
Sub DoNotContainClearCells()
Dim rng As Range
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
rng.Cells.SpecialCells(xlCellTypeFormulas).Clear
End Sub
EDIT#1:
If you wish to clear cells not containing formulas then:
Sub DoNotContainClearCells()
Dim rng As Range
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
rng.Cells.SpecialCells(xlCellTypeConstants).Clear
End Sub
will leave the formula cells alone!.
Try with below
Sub DoNotContainClearCells()
Dim rng As Range
Dim cell As Range
'What range ?
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
For Each cell In rng.Cells
If Not cell.HasFormula Then cell.Clear
Next cell
End Sub
I basically want a macro to insert the selection as comments to a selected range. So basically I would require to have two selected ranges? How does this work?
My problem- I have the comments for the cells in a different sheet in rows. And in the second sheet I have column headers for which I need those rows as comments to be inserted.
Sub TextIntoComments_GetFromRight()
Dim cell As Range
Selection.ClearComments
For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
If Trim(cell.Offset(0, 1).Text) <> "" Then
cell.AddComment cell.Offset(0, 1).Text
cell.Comment.Visible = False
cell.Comment.Shape.TextFrame.AutoSize = True
End If
Next cell
End Sub
The following code will accept two range inputs from the user. One for the range that needs comments, and one for the range of comments. These two ranges must be the same size. It will then add the text from the second range as comments to the first range. This will work regardless of which sheet the two ranges are on.
Sub TextIntoComments_GetFromRight()
Dim CommentRange As Range
Dim CellComments As Range
Dim cell As Range
Dim cell2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set CommentRange = Range("A1")
Set CellComments = Range("A1:A2")
Do Until CommentRange.Rows.Count = CellComments.Rows.Count And CommentRange.Columns.Count = CellComments.Columns.Count
Set CommentRange = Application.InputBox("Select the range that needs comments.", Type:=8)
Set CellComments = Application.InputBox("Select the range of comments to be inserted.", Type:=8)
If CommentRange.Rows.Count <> CellComments.Rows.Count Or CommentRange.Columns.Count <> CellComments.Columns.Count Then MsgBox "The range sizes do not match. Please select matching range sizes.", vbCritical
Loop
Set ws1 = CommentRange.Worksheet
Set ws2 = CellComments.Worksheet
CommentRange.ClearComments
For Each cell In CommentRange
Set cell2 = ws2.Cells(CellComments.Row + (cell.Row - CommentRange.Row), CellComments.Column + (cell.Column - CommentRange.Column))
If cell2.Text <> "" Then
cell.AddComment cell2.Text
cell.Comment.Visible = False
cell.Comment.Shape.TextFrame.AutoSize = True
End If
Next cell
End Sub