I'm unsuccessfully trying to create a macro to insert blank row based on cell value.
I have a bulk data, in which one column has differing numbers. Based on the column value, I need to insert a blank row below it.
If I understand you properly this should do what you want.
Just change "A:A" to the range your working with and the If cell.Value = 1 Then to the condition you need to find the cell you want to add a blank row under.
Dim i As Range
Dim cell As Range
Set i = Range("A:A")
For Each cell In i.Cells
If cell.Value = 1 Then
cell.Offset(1).EntireRow.Insert
End If
Next
The below is an example for if you are looking to insert a blank row based on a sudden change of value in a column (in this case column "C"):
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 3 Step -1
If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then Rows(lRow).EntireRow.Insert
Next lRow
You can change Cells(lRow - 1, "C") to whatever value you want to trigger your row insert and, of course, what column this is being applied to.
Related
VBA question using Excel 2016 (64 bit)
I have header data in the first two columns (A:B) and the top row (1). I would like to dynamically paste a formula downward, starting from cell C2, to the last row and the last column. The working prototype is as follows:
Dim LstCol As Long
LstCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, "C"), Cells(2, LstCol)).Value = "=INDEX(RC1,MATCH(R1C,RC2,0))"
Dim LstRow As Long
LstRow = Cells(1, Rows.Count).End(xlUp).Row
Range(Cells(2, "C"), Cells(2, LstRow)).Value = "=INDEX(RC1,MATCH(RC1,R2C,0))"
The first Dim works as intended. The formula is successfully deployed throughout the second row to the final column (or perhaps it starts at the last column and moves leftward). However, the second Dim stops on an error. I'm unsure how to spread the data from the last row (to the last column) upwards to the second row (and the corresponding last column).
In my example, the first two columns have header data from 1 to 5330 (A1:B5330). I also have header data in the first row (C1:AX1). My target is to fill the formula =INDEX($A2,MATCH(D$1,$B2,0)) from C2:AX5330 dynamically.
Where am I going wrong?
You need to properly qualify your instances of Range and Cells with a worksheet. You can either directly do this, dim a worksheet variable, or use a With block like so:
Dim LRow as Long
With ThisworkBook.Sheets("????")
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("C2:AX5330").Formula = "=INDEX($A2,MATCH(D$1,$B2,0))" 'Make sure your cell references are correct here
.Range("C2:AX5330").Value = .Range("C2:AX55330").Value 'Place as values instead of formula
End With
I am trying to create a macro that will copy a range of values say B6:BM6 and paste it in the row below IF there is a value in column A.
So: if column A6 is populated, copy range from rows above and paste them into B6. Loop until there is no value in column A.
Sub fillEmptycells()
Dim i As Integer
Dim lastRow As Integer
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
If IsEmpty(.Cells(i, 2)) And Not IsEmpty(.Cells(i, 1)) Then
.Range(Cells(i - 1, 2), Cells(i - 1, 100)).Copy .Cells(i, 2)
End If
Next i
End With
End Sub
Can someone help me please?
At the moment you are only copying one cell, not a whole range. You need to change the range you call the Copy method on to include all of the cells you want to copy. The code in your If statement would be changed to something like:
.Range(Cells(i-1,2),Cells(i-1,x)).Copy .Cells(i,2)
Where x would be the column number of the last column you want to copy.
This process is being used for QC purposes. I have a spreadsheet that highlights certain cells that are wrong based off of their values and the validation rules we have in place. I was wonder if there was a way to return the column names of each cell that is colored into column A for each row? So for example if D2, F2, and G2 are wrong it would put all of those column headers in A2 to specify what exactly is wrong. I know it gets a bit more complicated trying to automate stuff with cell colors and I am not experienced in VBA which I'm assuming this will need. Is this possible to do, if so what would be the proper route to take? The data runs from column A to column BS, and the row numbers may differ, so if it could run up to row 1,000 that would be great. Attached is what the data looks like that I am working with.
The red means something is wrong in that row, and the orange cell is the color indicating that it is a wrong value
Yes, it is possible to do. Here is some snippets of code I pulled together to help get you started.
Lastrow = Cells(Rows.count, "A").End(xlUp).Row 'Get last row
With ActiveSheet
Lastcol = .Cells(1, .Columns.count).End(xlToLeft).Column 'Get last col
End With
For x = 1 To Lastcol 'Iterate Col
For i = 1 To Lastrow 'Iterate Row
'if red....
If Cells(i, x).Selection.Interior.Color = 255 then
'Move name to Cell A and append off of old name(s).
Cells(i, "A") = Cells(i, "A") & ", " & Cells(i, x)
End If
Next i 'next row
Next x 'next col
I have a report that I pull everyday that is placed in a very awekward format. It's contains a variable row count by 4 columns organized into unofficial tables based on the Name of each employee.
What I have is an employee name in column B preceded 2 blank rows above and followed by 1 blank row of data below.
What I want to accomplish is loop through the data, identify cells in column B <> blank, delete the entire 2 rows below that cell, and delete the entire 1 row above that cell.
Below is what I have so far. not much:
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long
Dim lastCol As Long
Dim i as integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1
If Cells(i, "B").Value <> "" Then
End Sub
without making major changes to your code, try this:
For i = lastRow To 1 Step - 1
If Cells(i, "B").Value <> "" Then
Range(Cells(i, "B").Offset(1), Cells(i, "B").Offset(2)).EntireRow.Delete 'delete two below
Cells(i, "B").Offset(-1).EntireRow.Delete ' delete one above
You already get to your non-blank cell (ie Cells(i,"b")). To reference a range in relation to a cell you already have, use OFFSET.
So, and in this order, you select a range of cells from one below your cell Offset(1) to two cells below Offset(2)'. Change this range toENTIREROW` for those cells, and delete.
Then you select the cell above Offset(-1), select the ENTIREROW and delete.
as per your question narrative you'd possibly need to delete all rows that has a blank cell in column "B"
should that be the issue than you could (disclaimer: test it on a copy sheet!) simply go like follows:
Sub test()
With ActiveWorkbook.Sheets(1)
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
I have column headings starting in Column L going forward. The column headings need to be in a certain order.
By hand, I have to insert columns so everything is in order. I put insert or delete in the question title because I assume it's easy to go between the two.
I have no idea how to start this. I have code for deleting rows when a observation is appended with "Total". However, how do I change it so it works for columns?
LR = ThisWorkbook.Sheets("Cheese_D").Range("A" & Rows.Count).End(xlUp).Row
With ThisWorkbook.Sheets("Cheese")
For i = LR To 2 Step -1
With ThisWorkbook.Sheets("Cheese").Range("A" & i)
If Right(.Value, 5) = "Total" Then .EntireRow.Delete
End With
Next i
End With
One way to look at columns in a range is like this:
Set rng = Range("L:S")
For Each col In rng.Columns
'do your logic and .EntireColumn.Delete
next
Or look at all columns in sheet like this:
For Each col in ThisWorkbook.Sheets("Cheese").Columns
'your logic
Next
Now to add in your logic:
Set rng = Range("L:S")
For Each col In rng.Columns
If Cells(1, col.Column).Value = "Total" Then col.EntireColumn.Delete
next
These four lines replace all your code in the original post.