I am new to macro Excel functions and I am trying to insert a row when there is a change in the cell value of a particular column. For example,
row_no B
1 p
2 p
3 p
4 q
5 q
6 q
7 q
A row should be inserted at row 3 as the value in column 1 has changed. Do you have any ideas?
Right now, this is my code.
Sub MySub()
Do While B1 <> B2
CurrentSheet.Range("a1:i1").EntireRow.Insert
Loop
End Sub
It is still not working, do all of you have any idea why?
Try this code:
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1") 'set you data sheet here
lastRow = Cells(Rows.Count, "A").End(xlUp).Row 'get the last row in column A
For i = lastRow To 2 Step -1 'loop from last row to row 2
If ws.Range("A" & i) <> ws.Range("A" & i - 1) Then 'compare value if not same
ws.Range("A" & i).EntireRow.Insert 'if value are not same insert row
End If
Next i
End Sub
Insert the following into your Sheet1 (Sheet1) VBA module (Or the module that pertains to the worksheet you want this functionality in)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 Then Rows(Target.Row + 1).EntireRow.Insert
Application.EnableEvents = True
End Sub
This inserts a row below the changed cell if that cell's column number is column 1 or A
Related
I made a button that adds a new row above another row where the value of the cell in column C is "add row above".
I did it like this because there is a formula on the row below that which totals all of column E.
So when I add a row above C with value add row above it auto updates the formula.
I need to copy a formula from column B into each now. The formula is =ROW(A1) so it numbers the row.
My code to add the new row:
Sub AddRow()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For i = Lastrow To 1 Step -1
If Cells(i, "C").Value = "Add row above" Then If i > 1 Then Rows(i).Resize(1).Insert xlUp
Next
Application.ScreenUpdating = True
End Sub
Insert Row and Copy Formula
Note that =ROW(A1), =ROW(Z1) or just =ROW() produces the same result.
Option Explicit
Sub AddRow()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For i = Lastrow To 2 Step -1
If Cells(i, "C").Value = "Add row above" Then
Rows(i).Insert xlShiftDown
Cells(i + 1, "B").Copy Cells(i, "B")
' Or (if below is not numbered):
'Cells(i - 1, "B").Copy Cells(i, "B")
End If
Next
Application.ScreenUpdating = True
End Sub
I find it easier to create a named range and refer to that. This way, if it moves around the sheet, the named range will follow it and you don't have to go looking.
When you do that, this code works quite easily, you just need to adapt it.
Also, the ROW() function doesn't actually need a parameter IF you want to refer to the row that the ROW() formula is on.
Public Sub AddRowAndCopyFormula()
Dim lngAddAtRow As Long
With ThisWorkbook.Names("AddRowAbove")
lngAddAtRow = .RefersToRange.Cells(1, 1).Row
.RefersToRange.Worksheet.Rows(lngAddAtRow).Insert xlShiftDown
.RefersToRange.Worksheet.Range("B" & lngAddAtRow).Formula = "=ROW() - 7"
End With
End Sub
This is what my worksheet looks like.
in the range A1 to A70, if a cell is empty/blank then delete that entire row and move the other rows underneath up
Thank you
Use following codes.
Sub RemoveDuplicate()
On Error Resume Next
Range("A1:A70").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Edit:
Sub RemoveBlankRowsInARange()
Dim rng As Range, rws As Long, i As Long
Dim LastRow As Long
' LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Set rng = ActiveSheet.Range("A2:A" & LastRow)
' rws = rng.Rows.Count
'
' For i = rws To 1 Step (-1)
For i = 100 To 1 Step (-1)
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).EntireRow.Delete
Next
End Sub
#Harun24HR - Here's how I attempted at solving this problem: I recorded a macro that deletes a row and I edited that macro to do my original question, why doesn't this work, please correct it:
Sub DeleteRowWithEmptyCell()
Dim row As Integer
For row = 1 To 100 'or whatever numbers needed
If Cells(row, 1).Value() = "" Then
Rows("row:row").Select
Selection.Delete Shift:=xlUp
End If
Next row
End Sub
I want to filter column B based on values like "Unknown", then filter L column to have un-null values. copy the L column.
Paste values only to the column B.
Before:
ColumnB ..... Column L
1 ..... a
2 ..... b
Unknown.c
3.......d
Unknown.e
Unknown.
After
1 ..... a
2 ..... b
c.......c
3.......d
e.......e
Unknown..
Set r1 = Range("B:B").SpecialCells(xlCellTypeVisible)
Set r2 = Range("L:L").SpecialCells(xlCellTypeVisible)
Set myMultipleRange = Union(r1, r2)
Application.ScreenUpdating = False
sh1.Range("B:L").AutoFilter
sh1.Range("B:B").AutoFilter Field:=1, Criteria1:="Unknown", Operator:=xlFilterValues
sh1.Range("L:L").AutoFilter Field:=11, Operator:=xlFilterValues, Criteria1:="<>"
LstRw = sh1.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
If LstRw <> 0 Then
myMultipleRange.FillLeft
End If
The above code will copy and paste including the format.
Copy/paste in a filtered table is no good idea, because it inserts data continously even in hidden rows and messes up your data.
I recommend the following:
Filter data
Loop through all visible cells and copy the data row by row
If the following data is given …
… and you want to replace unkown with the data in column L, you can do the following:
Option Explicit
Public Sub FilterAndCopy()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Tabelle1")
'Filter data
ws.Range("B:B").AutoFilter Field:=1, Criteria1:="Unknown", Operator:=xlFilterValues
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Dim DestinationRange As Range
On Error Resume Next 'next line throws error if filter returns no data rows
Set DestinationRange = ws.Range("B2", "B" & LastRow).SpecialCells(xlCellTypeVisible) 'find visible cells between B2 (exclude header) and last row in B
On Error GoTo 0 'always re-activate error reporting!
If Not DestinationRange Is Nothing Then 'do it only if there is visible data
Dim Cell As Range
For Each Cell In DestinationRange 'copy each value row wise
Cell.Value = Cell.Offset(ColumnOffset:=10).Value 'column L is 10 columns right of B
Next Cell
End If
End Sub
Alternative solution - simply go through each cell in column B and replace "Unknown" with a respective value in column L.
Sub foo()
Dim lngLastRow As Long
Dim rngCell As Range
With Sheet1
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
For Each rngCell In .Range("B1:B" & LastRow)
If rngCell.Value = "Unknown" Then
rngCell.Value = .Range("L" & rngCell.Row).Value
End If
Next rngCell
End With
End Sub
P.S. Make sure to replace With Sheet1 statement with a relevant sheet name/code.
I need to clear data between first cell and last cell
in a excel column. I tried this code, but it deletes the data from the entire sheet, I need only for a specific column.
Sub DeleteRow()
Dim i1 As Long
Dim iMax As Long
iMax = Cells.SpecialCells(xlCellTypeLastCell).row
For i1 = iMax - 1 To 2 Step - 1
Rows(i1).EntireRow.Clear
Next i1
End Sub
This would clear content between the first row and the last row in column A.
Sub ClearRows()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & lastRow - 1).ClearContents
End Sub
I have a value in Column A which I want to write to a separate sheet, there are column and row numbers which specify the location I want to write that value in the same row as the value in column A.
For instance the value in A8 has column number "2" in Q8 and row number "118" in S8. So I want to write a formula in the new sheet which puts the value of A8 into cell B118 in the new sheet. And for this to go down with all the values in A:A as the first sheet continues to be filled in.
I've tried doing this with sumifs formula here but its not quite working out;
=IF(SUMIFS(sheet1!$A:$A,sheet1!$Q:$Q,COLUMN(B8),sheet1!$S:$S,ROW(B8))," ",sheet1!$A:$A)
If you want the formula in the new sheet to reference the cell in Sheet1 then:
Sub marine()
Dim cl As Long, rw As Long, source As String
cl = Range("Q8").Value
rw = Range("S8").Value
Sheets("new").Cells(rw, cl).Formula = "=Sheet1!A8"
End Sub
and if you simply want A8's value transferred to the new sheet, then:
Sub marine2()
Dim cl As Long, rw As Long, source As String
cl = Range("Q8").Value
rw = Range("S8").Value
Sheets("new").Cells(rw, cl).Value = Range("A8").Value
End Sub
EDIT#1:
Here is a version that will handle the entire column:
Sub marine3()
Dim cl As Long, rw As Long, source As String
Dim i As Long, N As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 8 To N
cl = Range("Q" & i).Value
rw = Range("S" & i).Value
If cl <> 0 And rw <> 0 Then
Sheets("new").Cells(rw, cl).Value = Range("A" & i).Value
End If
Next i
End Sub
Here is my answer.
Sub movindData()
'take all the data from sheet1 and move it to sheet2
Dim sht2 As Worksheet
Dim r
Dim c
Dim i
Dim rng As Range
Dim A 'for each value in column A
Dim Q 'for each value in column Q (the column)
Dim S 'for each value in column S (the row)
r = Range("A1").End(xlDown).Row 'the botton of columns A, the last row
'I take the inicial cells as a A1, but you
'can change it as you need.
c = 1 'the column A
Set rng = Range(Cells(1, 1), Cells(r, c)) 'this takes just the range with the data in columns A
Set sht2 = Sheets("Sheet2")
For Each i In rng
A = i.Value 'Store the value of every cell in column A
Q = i.Offset(0, 16).Value 'Store the value of every cell in column Q (the destination column in sheet2)
S = i.Offset(0, 18).Value 'Store the value of every cell in column s (the destination row in sheet2)
sht2.Cells(Q, S).Value = A
Next i
End Sub