The following code should delete every row but the first. However, it deletes every second row.
Dim index As Long
For index = 2 To ActiveDocument.Tables(1).Rows.Count
ActiveDocument.Tables(1).Rows(index).Delete
Exit For
Next
The solution is to loop backwards using Step -1.
Dim index As Long
For index = ActiveDocument.Tables(1).Rows.Count To 2 Step -1
ActiveDocument.Tables(1).Rows(index).Delete
Next
Deleting just the last row is as simple as:
With ActiveDocument.Tables(1)
.Rows(.Rows.Count).Delete
End With
Related
I have an issue I'm unable to resolve myself and was wondering if anyone here could help me. I have table with a lot of values which are broken down into different sections (separated by an empty row). I need to be able to control where a new row is inserted with the use of a macro.
What I would like to do is to create a macro with conditions so that I can control where an empty row are to be inserted. My take is to create separate buttons next to each sections (before an empty row) that assigns a value so that loop may skip through x number of empty rows before inserting a new row. My first take is like this:
Sub InsertNewRow()
Dim erow As Integer
Dim number As Integer 'number of empty rows to skip
Dim count As Integer 'to keep track on number of empty rows to skip
Dim LastRow As Long
erow = ActivityInput.UsedRange.Rows.count
count = 0
For Each l In erow
Do While i <> ""
Next erow
count = count + 1
If element = count Then
'Cells(Rows.count, 1).End(xlUp).Offset(1, 0).EntireRow.Insert
'This is as far as I got. I don't know how to make the macro go to the last row of the current section... any suggestions?
..
To clarify, I would like to add macro(s) (bottons) that helps the user to insert new rows. If the user is at section 3 (2 empty rows have been passed which separates the different sections), I would like the user to be able to click on the macro (button) which then subsequently adds a new row to the current section.
Any ideas?:/
Regards,
Alexander
Sub InsertNewRow(X As Integer)
Dim count As Integer
count = 0
For i = 1 To ActivityInput.Range("X[ABC]")(i)
If i <> "" Then Next i
ElseIf X = count Then
Cells(l, 1).End(xlDown).Offset(1, 0).EntireRow.Insert
Else
count = count + 1
Next l
End Sub
I'm currently running a macro which identifies duplicates in a workbook, however it identifies the first set off the index and doesn't tag the first set then which has led to me setting up a if statement to by pass this, which adds duplicate to the first instance too. This is taking a long time to do however and would like to improve this, if possible. Any suggestions would be greatly appreciated, I am new to VBA but have been learning bits as I've encountered new problems!
'Declaring the lastRow variable as Long to store the last row value in the Column1
Dim lastRow As Long
'matchFoundIndex is to store the match index values of the given value
Dim matchFoundIndex As Long
'iCntr is to loop through all the records in the column 1 using For loop
Dim iCntr As Long
Dim first_dup As Long
Dim tagging As Long
Dim item_code As String
'Finding the last row in the Column 1
lastRow = Range("B1000000").End(xlUp).Row
'
'looping through the column1
For iCntr = 2 To lastRow
'checking if the cell is having any item, skipping if it is blank.
If Cells(iCntr, 1) <> "" Then
'getting match index number for the value of the cell
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
'if the match index is not equals to current row number, then it is a duplicate value
If iCntr <> matchFoundIndex Then
'Printing the label in the column B
Cells(iCntr, 4) = "Duplicate"
End If
End If
Next
For first_dup = 2 To lastRow
If Cells(first_dup, 5) = "Duplicate" Then
item_code = Cells(first_dup, 1)
For tagging = 2 To lastRow
If Cells(tagging, 1) = item_code Then
Cells(tagging, 5) = "Duplicate"
End If
Next
End If
Next
Example data:
item code
1
2
3
4
1 duplicate
2 duplicate
3 duplicate
4 duplicate
1 duplicate
2 duplicate
3 duplicate
4 duplicate
My first suggestion is not to over-complicate things, try using duplicate values conditional formatting to see if this helps:
Failing that, if you are desperate to find ONLY the duplicates, and not the first occurrence, you can use a formula like this: (In Cell B2 if your Data starts in A2, it will require a header row that doesn't match, or your first row will always match)
=IF(COUNTIF($A1:A$1,A2)>=1,"Duplicate","")
Which when pasted down your row of data could look something like this:
There are also VBA solutions if you are desperate for a VBA solution, but I thought I'd give you the simple ones first. Let me know how you get on in the comments.
Edit: you can just insert the above formula using VBA, with R1C1 notation, e.g.:
Sub test()
Range("B2:B" & Range("A1").End(xlDown).Row).FormulaR1C1 = "=IF(COUNTIF(R1C1:R[-1]C1,RC1)>=1,""Duplicate"","""")"
End Sub
I'll break this down so you know what is happening.
Range("B2:B" & Range("A1").End(xlDown).Row) selects the cells in column B between B2 and the last filled row in column A i.e. Range("A1").End(xlDown).Row (so this won't work if you expect blanks in column A as part of your data)
Then, it sets the R1C1 ref formula to "=IF(COUNTIF(R1C1:R[-1]C1,RC1)>=1,""Duplicate"","""")", where R1C1 means first row, first column, (i.e. $A$1)
R[-1]C1 means previous row, first column. For example,
If you are in B5, this would select A4.
If you are in A2, this would select A1.
If you are in A1, this would error out because you cant be in a row earlier than 1.
And RC1 means current row, first column.
Hope this helps!
The answer was the same as the initial code I presented, it's taking roughly 5 minutes for 30000 items so it isn't too bad at what it does.
I am trying to come up with a lean and error-proofed macro to delete rows containing duplicate values in a column A. I have two solutions and both have their advantages. None of them are exactly what I want.
I need rows containing duplicates deleted but leaving the last row that contained the duplicate.
This one is awesome. It has no loop and works instantaneously. The problem is that it deletes subsequent rows containing duplicates hence leaving the first occurrence of the duplicate (And I need the last/ or second - most show up only twice)
Sub Delete()
ActiveSheet.Range("A:E").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
This one goes from the bottom and deletes duplicates. It lasts longer than the first one ( I have around 6k rows) But the issue with this one is that it doesnt delete them all. Some duplicates are left and they are deleted after I run the same code again. Even smaller number of duppes is still left. Basically need to run it up to 5 times and then I end up with clean list.
`
Sub DeleteDup()
Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long
LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For n1 = 1 To LastRowcheck
With Worksheets("Sheet1").Cells(n1, 1)
If Cells(n1, 1) = Cells(n1 + 1, 1) Then
Worksheets("Sheet1").Cells(n1, 1).Select
Selection.EntireRow.Delete
End If
End With
Next n1
End Sub
`
Is there a way to improve any of these to work well or is there a better solution? Any info is greatly appreciated. Thanks
The easiest way would be to delete all rows at once. Also to increase speed, you better do your checks with variables and not with the real cell values like this:
Sub DeleteDup()
Dim LastRowcheck As Long
Dim i As Long
Dim rows_to_delete As Range
Dim range_to_check As Variant
With Worksheets("Sheet1")
LastRowcheck = .Cells(Rows.Count, 1).End(xlUp).Row
range_to_check = .Range("A1:A" & LastRowcheck).Values
For i = 1 To LastRowcheck - 1
If range_to_check(i, 1) = range_to_check(i + 1, 1) Then
If rows_to_delete Is Nothing Then
Set rows_to_delete = .Cells(i, 1)
Else
Set rows_to_delete = Union(.Cells(i, 1), rows_to_delete)
End If
End If
Next n1
End With
rows_to_delete.EntireRow.Delete
End Sub
The concept is right, but remember that when you delete rows, Cells(n1 + 1, 1) isn't going to be the same thing as it was before you deleted a row. The solution is to simply reverse the loop and test rows from bottom to top:
Sub DeleteDup()
Dim last As Long
Dim current As Long
Dim sheet As Worksheet
Set sheet = Worksheets("Sheet1")
With sheet
last = .Range("A" & .Rows.Count).End(xlUp).Row
For current = last To 1 Step -1
If .Cells(current + 1, 1).Value = .Cells(current, 1).Value Then
.Rows(current).Delete
End If
Next current
End With
End Sub
Note that you can use the loop counter to index .Rows instead of using the Selection object to improve performance fairly significantly. Also, if you grab a reference to the Worksheet and toss the whole thing in a With block you don't have to continually dereference Worksheets("Sheet1"), which will also improve performance.
If it still runs too slow, the next step would be to flag rows for deletion, sort on the flag, delete the entire flagged range in one operation, then sort back to the original order. I'm guessing the code above should be fast enough for ~6K rows though.
I am new to VBA for excel and I am stuck with a little problem. I have to delete an entire row if the value in column D is greater than the value in column E.
The list of data is very long and I will need the action to continue until the data in column C ends. Any help would be great!
When deleting rows, start at the bottom and work up or you may skip rows due to the renumbering associated with a newly deleted row.
Sub del_D_greater_than_E()
Dim rw As Long
With Worksheets("Sheet5") '<~~ set this properly!
For rw = .Cells(Rows.Count, "C").End(xlUp).Row To 2 Step -1
If .Cells(rw, "D").Value2 > .Cells(rw, "E").Value2 Then
.Rows(rw).EntireRow.Delete
End If
Next rw
End With
End Sub
That should be enough to get you started. You may want to turn off screen updating and calculation during the operation.
I am trying (using VB) to copy 7 values from 1 location to another.
(copy from F115 to F134.)
(F115 is source of numbers; F134 is destination for numbers)
If there is data (any data) in F134 I want to advance the row by 1 and then print/copy. I do not want to overwrite any lines of data.
So, if there is data in the first row (F134) then I want to move/advance the row count by 1 and then copy the values into row F135 - and so on. It's possible that there could be 500 to 100 rows of numbers and I need to be able to view all of this data.
So far, this is the code I have: some works, but it does NOT advance the row count and continues to print into Cell F134. (oh yes, F124 is just a set of empty cells.)
Ok, this is my code;
Sub dbtest4()
Dim RowCounter As Integer
rowCounter = 1
Do Until rowCounter = rowCounter +1
'trying to advance the row counter by 1 such that if there is data in F134, the line count will advance and the new data will print into the NEXT line. (which would be F135)
'the following code probably is unnecessary, but I'm trying anything...
'actually the following code works ok: Range("F134").Resize(1,7).Value = Range("F115").Resize(1,7).Value, but that's about it.
If Range ("F134") = 0 then
Range("F134").Resize(1,7).Value = Range("F115").Resize(1,7).Value
'trying to print data cells from F124 if there is no data in F134
Else
Range("F134"),Resize(1,7).Value = Range("F124).Resize(1,7).Value
'trying to print the zeros or blank numbers from F115 if F134 has data in it
End if
Loop
Exit Do
End Sub
Thanks to anyone who may be able to offer some assistance.
So right now the exit condition for the Do While loop is that rowCounter has to increment by one. I can't see a reason why this should fail and that is why it is only happening once. Here is some psuedocode:
Do Until copiedVals = 7 'Or whatever exit value you want
If row.Value.Exists() then
'There is a value in this row, so increment the row count
rowCounter = rowCounter + 1
Else
'This row is empty and you can do your thing
'rowCounter will have the current row value
copiedVals = copiedVals + 1
End If
End Loop