i have this macro it is supposed to delete all the cells that doesnt have a background set to them, but when I execute the macro if two or more contiguous cells doesnt have a background it only deletes one of them, here is the code:
Sub Macro1()
Dim a As Range
Set a = Hoja1.Range("A1:A12")
For Each cell In a
If cell.Interior.ColorIndex = xlNone Then
cell.EntireRow.Delete
End If
Next
End Sub
Sub Macro1()
Dim a As Range, x As Long
Set a = Hoja1.Range("A1:A12")
For x = a.cells.count to 1 Step -1
with a.cells(x)
if .Interior.ColorIndex = xlNone Then .EntireRow.Delete
End With
Next x
End Sub
Related
I have a table that has a header and the first column has student names. the rest of the table has student scores.
I need to highlight all the cells with zeros in them so far this is what i got
Sub HighLightZeros()
Dim region As Range
Set region = ActiveSheet.Range("a1").End(xlDown)
If region.Value = 0 Then
region.Interior.Color = vbYellow
Else
region.Interior.ColorIndex = xlColorIndexNone
End If
End Sub
Also I have to make the macro so that when I add more scores to end on the table that it still highlights all the zero values. I am having trouble in figuring out how to select the entire table.
you could like follows
Sub HighLightZeros()
With ActiveSheet.UsedRange
With .Resize(, .Columns.Count - 1).Offset(, 1) 'reference all "used" cells except column A ones
.Interior.ColorIndex = xlColorIndexNone ' uncolor referenced range
.Replace what:=0, lookat:=xlWhole, replacement:="XXX" ' replace 0's with "XXX"
.SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues).Interior.Color = vbYellow ' color referenced range cells with text content in yellow
.Replace what:="XXX", lookat:=xlWhole, replacement:=0 ' replace "XXX"'s with 0
End With
End With
End Sub
trying to build up some working code from your skeleton in the question, it could be
Sub HighLightZeros2()
Dim region As Range, cell As Range
Set region = Range("a1", Range("A1").End(xlDown))
For Each cell In region
If cell.Value = 0 Then
cell.Interior.Color = vbYellow
Else
cell.Interior.ColorIndex = xlColorIndexNone
End If
Next
End Sub
but it'd scan the first column cells only
This is less efficient than #DisplayName's method but another way. Assumes table is an actual table (List object. Created with Ctrl + T)
Option Explicit
Sub HighlightZeroes()
Dim table As ListObject
Dim currentCell As Range
Set table = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1") 'change as required
For Each currentCell In table.DataBodyRange
With currentCell
.Interior.ColorIndex = xlColorIndexNone
If .Value = 0 Then .Interior.Color = vbYellow
End With
Next currentCell
End Sub
I'm trying to copy and paste the cells in each row C through F if the value in column C is greater than 0. Please help thanks!
Private Sub CommandButton2_Click()
Dim range1 As Range
Dim Cell As Object
Set range1 = Sheet1.Range("C8:C40")
For Each Cell In range1
If IsEmpty(Cell) Then
End If
If Cell.Value > 0 Then
Sheet1.range(C:F).Copy
Sheet5.Select
ActiveSheet.Range("A40").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
You need to set the row that is being tested.
Also do not use .Activate or .Select It only slows down the code.
Private Sub CommandButton2_Click()
Dim range1 As Range
Dim Cell As Range
Set range1 = Sheet1.Range("C8:C40")
For Each Cell In range1
If Cell.Value > 0 Then
With Sheet1
.Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Copy Sheet5.Range("A40").End(xlUp).Offset(1, 0)
End With
End If
Next
End Sub
To do it with just the values, no formatting, Change this:
.Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Copy Sheet5.Range("A40").End(xlUp).Offset(1, 0)
To:
Sheet5.Range("A40").End(xlUp).Offset(1, 0).Resize(,4).Value = .Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Value
In my current Excel worksheet, I would like to move the selected non-contiguous cell contents to the right and up, from this:
to this:
I tried the following macro:
Sub move()
Selection.Offset(-1, 1).Value = Selection.Value
Selection.ClearContents
End Sub
but ended up with this:
Is there a way to keep the contents of A5 and A8 after moving? Thanks!
EDIT : Finally, is it possible to delete the original rows (A2, A5, and A8 in my example) after moving the selected cell contents?
I personally do not like the use of Selection but if you insist, the following may help.
Sub test()
Dim rngTemp As Range
For Each rngTemp In Selection.Areas
rngTemp.Copy Destination:=rngTemp.Offset(-1, 1)
rngTemp.ClearContents
Next rngTemp
End Sub
Another way
Sub Sample()
Dim aCell 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
For Each aCell In Selection
aCell.Cut Destination:=aCell.Offset(-1, 1)
Next aCell
End Sub
You may try something like this....
Sub TransformData()
Dim cell As Range
For Each cell In Selection
cell.Offset(-1, 1) = cell
Next cell
Selection.ClearContents
End Sub
No select copy data.
Sub test()
Dim rngDB As Range, rng As Range
Dim i As Long, n As Long
Set rngDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
n = rngDB.SpecialCells(xlCellTypeConstants).Areas.Count
For i = 1 To n
Set rng = rngDB.SpecialCells(xlCellTypeConstants).Areas(i)
rng(rng.Rows.Count).Copy rng.Range("a1").Offset(, 1)
rng(rng.Rows.Count).Clear
Next i
End Sub
I have a matrix of data which contains 16 columns and 300 rows. This data I get it from FORTRAN code. So times I get some blank cells in first column and then that row would have 17 columns. Now I would like to shift the data into blank cells making the matrix uniform.
I am not an expert into VBA. It would be great if you help me with the problem.
So far I have
Sub fillBlanks(Optional ByRef currentSheet As Worksheet)
Dim blanx As Range
If currentSheet Is Nothing Then Set currentSheet = ActiveSheet
currentSheet.Activate
On Error Resume Next
Set blanx = Range("B1", currentSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Address).SpecialCells(xlCellTypeBlanks)
If blanx Is Nothing Then Exit Sub
On Error Goto 0
currentSheet.Range(blanx.Address).FormulaR1C1 = "=RC[1]"
End Sub
Thank you.
Starting with this:
Running this:
Sub dural()
For i = 1 To 15
With Cells(i, 1)
If .Value = "" Then .Delete shift:=xlToLeft
End With
Next i
End Sub
will produce this:
I have two ranges of data that I want to compare with and format if they match. So I want to format a range 1 cell if any of that data matches to the the data in range 2. This is what I have so far - it works until I change the data to range 2 but doesn't update it:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRange As Range, cell As Range
Set myRange = Range("a9:a12")
For Each cell In myRange
If cell.Value = ActiveCell.Value And Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Interior.ColorIndex = 3
End If
Next cell
End Sub
The problem is the cell still stays the colors that it was formatted from the first block of code so how can I change it back if the data in the second range gets changed?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange1 As Range
Set myRange1 = Range("f9:f12")
If Not Intersect(Target, Range("f1:f6")) Is Nothing Then
If Application.WorksheetFunction.CountIf(myRange1, ActiveCell.Value) > 0 _
Then ActiveCell.Interior.ColorIndex = 3 Else ActiveCell.Interior.Color = xlNone
End If
End Sub
Is this what you are trying?
If cell.Value = ActiveCell.Value And _
Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Interior.ColorIndex = 3
Else
ActiveCell.Interior.Color = xlNone
End If
EDIT
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRange As Range
Set myRange = Range("a9:a12")
If Application.WorksheetFunction.CountIf(myRange, ActiveCell.Value) > 0 _
Then ActiveCell.Interior.ColorIndex = 3 Else ActiveCell.Interior.Color = xlNone
End Sub
EDIT
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Set myRange = Range("f9:f12")
If Not Intersect(Target, myRange) Is Nothing Then
If Application.WorksheetFunction.CountIf(myRange, Target.Value) > 0 _
Then Target.Interior.ColorIndex = 3 Else Target.Interior.Color = xlNone
End If
End Sub
You seem to be taking a somewhat inefficient route with your loop and are ignoring one of the tools (e.g. Target) that is being provided to you.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'important for _SelectionChange event macros
'only process the cells to the extents of the data, not whole rows or columns
If Not Intersect(Target, Target.Parent.UsedRange) Is Nothing Then
Dim c As Range
For Each c In Intersect(Target, Target.Parent.UsedRange)
c.Interior.ColorIndex = 3 + _
4145 * IsError(Application.Match(c.Value2, Range("A9:A12"), 0))
Next c
End If
End Sub
For a Worksheet_SelectionChange event macro, the Target represents one or more cells that is the current Selection. By cycling through each of the cells in the current selection, you can perform this pseudo-Conditional Formatting on a larger range. The Target or Selection can be any number of cells up to the total number of cells in a worksheet but the ActiveCell property can only ever be a single cell.
I've reduced the color on/color off switch to a single worksheet MATCH function and a little maths. This does away with looping through the criteria cells.
Because you may want to select entire row(s) or column(s) at some point, I've included a cell processing 'limit' that will process to the extents of the data on the worksheet. Without a cap on the cells to process, it is very easy to get caught up in the unnecessary processing of entire rows or columns of blank cells when using Worksheet_SelectionChange.