Hello!
I am trying to build a code that loops through each cell in range C8:C3276 and inserts a new row below if the cell value is "Total".
Here is the code i have so far:
Sub Create_new_rows()
Dim rng As Range
Dim cell As Range
Set rng = Range("C8:C3276")
For Each cell In rng
If ActiveCell.Value = "Total" Then
ActiveCell.Offset(1, 0).Activate
ActiveCell.EntireRow.Insert
End If
Next cell
End Sub
Nothing happens when i execute the code. I assume the code is built incorrectly as the macro runs (i get no error message), but without doing anything.
Any help is greatly appreciated! :)
Two problems I think. 1) You should loop backwards as otherwise you will skip rows as you are adding more rows, and 2) in your loop you should have referred to cell rather than the ActiveCell which is never set.
Sub Create_new_rows()
Dim rng As Range, r As Long
Set rng = Range("C8:C3276")
For r = rng.Count To 1 Step -1
If rng(r).Value = "Total" Then
rng(r + 1).EntireRow.Insert
End If
Next r
End Sub
Related
I'm trying to build a VBA application that checks for a certain value, then adds a row on top for each time this value is found.
Sub copy()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("B2:B10")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.value = "test" Then
MsgBox "found" + cell.Address
cell.EntireRow.Insert
End If
Next cell
Next row
End Sub
Every time I try to run this function, however, it keeps adding rows on top of each other continuously and not for each occurrence.
If you loop the cells from top to bottom, adding the row will push your original range down, causing the next loop to evaluate the previous cell.
To avoid this, loop backwards (i.e. bottom to top):
Sub copy_test()
Dim rng As Range
Set rng = Range("B2:B10")
Dim i As Long
For i = rng.Cells.Count To 1 Step -1
If rng.Cells(i).Value = "test" Then
Debug.Print "Found"
rng.Cells(i).EntireRow.Insert
End If
Next i
End Sub
Note: Set rng = Range("B2:B10") is telling VBA that you are referring to Cells B2:B10 of the ActiveSheet which might not be what you want.
Please fully qualify your range to avoid this. (e.g. ThisWorkBook.Worksheets("Sheet1").Range("B2:B10") or use the code name of the worksheet Sheet1.Range("B2:B10").)
I'm new at using VBA. I'm creating a macro that scans through each cell within a range to detect any cells filled with yellow, deleting them, and shifting up. Then it should move to the next cell in the data table.
I'm getting "Run-time error '1004': Delete method of Range class failed", which I think is about the Range object I declared, but I'm not sure how I should properly implement this or if there's a better way to execute this VBA? This is what I have so far.
Sub DeleteHighlight()
Dim cell As Range
For Each cell In Range("A6:O3863")
If ActiveCell.Interior.Color <> RGB(255,255,0) Then
ActiveCell.Delete Shift:=x1ToUp
Exit For
End If
Next cell
End Sub
#Warcupine is right that you're going to end up skipping rows. Instead, you should loop from the bottom to the top.
Sub DeleteHighlight()
Dim lRow As Long
'find last row
lRow = Range("A1").CurrentRegion.Rows.Count
'loop backwards
For i = lRow To 1 Step -1
If Cells(i, 1).Interior.Color = RGB(255, 255, 0) Then
Rows(i).Delete
End If
Next
End Sub
Scan upwards to avoid missing the cell below the deleted one. (Untested)
Sub DeleteHighlight()
Dim r as Long, c as Long
For r = 3863 to 6 Step -1
For c = 1 To 15 'O
If Cells(r,c).Interior.Color = RGB(255,255,0) Then
Cells(r,c).Delete Shift:=xlToUp
End If
Next
Next
End Sub
I would like a code to check every cell in range A1:A14 and if the cell is highlighted say yes or no in column B.
.
Sub highlighted()
Dim rng As Range
Dim c As Range
Set rng = ActiveCell
For Each c In rng
If c.Interior.Pattern <> xlNone Then
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "Yes"
Exit Sub
End If
Next c
End Sub
This code works sucsessfully for one single highlighted cell, how can I get it to loop through my desired range, and also include the "no" for non-highlighted cells?
Thanks In Advance!
This would be the code. Read the comments and adjust according your needs.
Sub highlighted()
Dim evaluatedRange As Range
Dim evaluatedCell As Range
Dim sheetName As String
Dim rangeAddress As String
' Adjust these two parameters
sheetName = "Sheet1" ' Sheet name where the range is located
rangeAddress = "A1:A14"
Set evaluatedRange = ThisWorkbook.Worksheets(sheetName).Range(rangeAddress)
' This will loop through each cell in the range
For Each evaluatedCell In evaluatedRange
' Evaluates if the cell has a pattern (what ever it is)
If evaluatedCell.Interior.Pattern <> xlNone Then
' Set the value of the cell next to the one evaluated (same row - rowOffset:=0 but next column columnOffset:=1) to Yes
evaluatedCell.Offset(rowOffset:=0, columnOffset:=1).Value = "Yes"
' Exit Sub -> This would exit the whole process, so if you want to evaluate the whole range, just delete this line
Else
evaluatedCell.Offset(rowOffset:=0, columnOffset:=1).Value = "No"
End If
Next evaluatedCell
MsgBox "Process finished!" ' -> alert the user...
End Sub
If this is what you need, remember to mark the answer to help others.
If I understand what you are trying to do, you could simply do:
Sub highlighted()
Dim rng As Range
Dim c As Range
Set rng = Range("A1:A14")
For Each c In rng
If c.Interior.Pattern <> xlNone Then
c.Range("A1").Offset(0,1).Value = "Yes"
End If
Next c
End Sub
See How to avoid using Select in Excel VBA for tips on avoiding unneeded Selects
I am trying to do a loop with Excel VBA, I have a data range in a1:a1000, I want to loop through them and copy one by one to single cell of C1, but below code not working, any idea what went wrong?
Dim I As Integer
For I = 1 To lastrow - 1
Sheets("display").Range("w1").Value = Sheets("data").Range("c1").Offset(I, 0).Value
msgbox Sheets("data").Range("c1").Value
Next I
You're setting the value in cell "W1" instead of "C1".
Updated After Author's Clarification of Question:
Below are two ways you can loop through cells and copy/paste. Neither one is "better". I would like to emphasize that there are probably more efficient methods than these to accomplish your task, but hopefully this answer gets you a resolution.
Sub LoopExampleUsingRange()
Dim aCell As Range
For Each aCell In Range("A1:A1000").Cells
aCell.Copy Range("C1")
Next aCell
End Sub
Sub LoopExampleUsingIntegerReference()
Dim i As Integer
For i = 1 To 1000
Range("A" & i).Copy Range("C1")
'I prefer to use offset, but they both work:
'Range("A1").Offset(i - 1, 0).Copy Range("C1")
Next i
End Sub
I've searched for similar questions, but the problem I'm having is that I'm adding what I'm looking for to an existing recorded macro that uses commands like:
Range(Selection, Selection.End(xlUp)).Select
to select a range.
This uses the Counta function, assuming there aren't any blanks in the data. I also added IsNumeric in case the value is text. If you wanted to go a step further to make sure everything is neat, you can add this right before the If statement:
Sub Minus_One()
Dim Cell As Range
Dim Cells As Range
Set Cells = Sheets(WhateverSheet).Range("A1:A" & Application.WorksheetFunction.CountA(Range("A:A")))
For Each Cell In Cells
If IsNumeric(Cell.Value) = True Then Cell.Value = Cell.Value - 1
Next Cell
End Sub
Cell.Value = Trim(Cell.Value)
Sub test()
Dim rngTarget As Range
Set rngTarget = Sheet1.Range("A1")
Set rngTarget = Range(rngTarget, rngTarget.End(xlDown))
Dim rngIndex As Range
For Each rngIndex In rngTarget
With rngIndex
.Value = .Value - 1
End With
Next rngIndex
End Sub