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
Related
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'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
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 would like some support in correcting this simple piece of code. when running the code it is always displaying 1 and then a miss match error box pops up. I cant see why this is not working the code seems simple enough.
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
For Each cell In rng
If cell.Value > 0 Then
MsgBox Application.WorksheetFunction.CountA(cell.Value)
End If
Next cell
End Sub
Here is one way:
Sub Test3()
Dim rng As Range, cell As Range, IAmTheCount As Long
Set rng = Range("D1:D10")
IAmTheCount = 0
For Each cell In rng
If cell.Value > 0 Then
IAmTheCount = IAmTheCount + 1
End If
Next cell
MsgBox IAmTheCount
End Sub
Since you are using a for each loop, you are counting the cells one by one. That's why the Msgbox always says 1. You should not use a loop to achieve what you want
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
MsgBox Application.WorksheetFunction.CountIf(rng, ">0")
End Sub