Hi I am using VB to populate data in excel. In the sheet, the column G has many cells with same numbers(and they are repeated without following any pattern). First I would like to find which entries are not unique and then keep the first occurrence in the column & delete the entire rows where repetitions are encountered. Here's an example:
As can be seen from the image, in the column G, numbers 1000 & 2200 are repeated. So need to delete entire rows 3 and 6 (keeping rows 1 & 2 where 1000 & 2200 appear first).
Here's the code which I can't get to work:
Sub Dupli()
Dim i As Long, dic As Object, v As Object
dic = CreateObject("Scripting.Dictionary")
i = 1
For Each v In sheet.UsedRange.Rows
If dic.exists(v) Then sheet.Rows(v).EntireRow.Delete() Else dic.Add(v, i)
i = i + 1
Next v
End Sub
Try something like this. I don't think you need a dictionary (unless there is some other need for it elsewhere in your code). When deleting objects, it's usually necessary to iterate backwards over the collection. This method just uses the CountIf function to test whether the cell value in column G of a specific row occurs more than once in all of column G, and deletes the row if that condition is true.
Sub Dupli()
Dim i As Long
Dim cl as Range
i = 1
For i= sheet.UsedRange.Rows.Count to 1 Step -1
Set cl = sheet.Cells(i,7) '## Examine the cell in Column G
If Application.WorksheetFunction.CountIf(sheet.Range("G:G"),cl.Value) > 1 Then
sheet.Rows(i).EntireRow.Delete
Next
End Sub
Put this in H1:
=COUNTIF(G$1:G1;G1)
Fill down to end
Make an autofilter on column G
Filter out values of 1
Select the remaining rows by row header
Right click on row header > click Delete ...
Related
I want to check if a table cell contains a bookmark, if so, get the name of that bookmark.
I used the method
Selection.Cells(1).Range.Bookmarks.Count
But the result is not correct, all cells in the same row return the same value, even though only 1 cell contains the bookmark.
However, when using Selection.Cells(1).Range.BookmarkID to check, only cells containing bookmarks will have a value of non-zero, cells without bookmarks will have a value of 0.
So I don't know how to determine the cell containing the bookmark.
I create a table with 3 rows and 5 columns and insert 3 bookmarks in column 2 and try the following test
Sub GetNameBookmark()
Dim i As Integer
Dim j As Integer
For i = 1 To 3
For j = 1 To 5
Debug.Print ActiveDocument.Tables(2).Rows(i).Cells(j).Range.BookmarkID & _
":" & ActiveDocument.Tables(2).Rows(i).Cells(j).Range.Bookmarks(1).Name
Next
Next
End Sub
Print results:
0:BM01
1:BM01
0:BM01
0:BM01
0:BM01
0:BM02
2:BM02
0:BM02
0:BM02
0:BM02
0:BM03
3:BM03
0:BM03
0:BM03
0:BM03
Seems pretty straightforward:
Sub GetNameBookmark()
With Selection.Cells(1).Range
If .BookmarkID > 0 Then Debug.Print .Bookmarks(1).Name
End With
End Sub
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 have a simple loop I want to use to cut and paste cells under conditions from one sheet to another one.
Dim i, b As Long
For b=1 To 18 Step 2
For i = 5 To 21
INTP = Sheets("Feuil1").Cells(i, 18+b)
client = Sheets("Feuil1").Cells(i, 17+b)
If IsNumeric(INTP) Then
Sheets("Feuil2").Columns(b).End(xlDown).Offset(1, 0) = client
End If
Next i
Next b
With that code the problem is that only the value when i=21 will be paste in my next sheet (Feuil2). Nothing happen for the other values ...
I cannot figure what I am missing, thanks
it looks like you are overwriting the values on top of each other, therefore only showing the last one (21).
Try replacing
Sheets("Feuil2").Columns(b).End(xlDown).Offset(1, 0) = client
with
Sheets("Feuil2").cells(frow,2)=client
frow=frow+1
and add
dim frow as integer
frow=1 '' or the first empty row in your list
to top of your sub
I have searched the forums but I am really struggling to get part of my code to work. Basically the idea is to search sheet 1 and copy one or more columns depending on the criteria to a specific worksheet.
i.e. if sheet 1 columns 1 and 3 contain "copy 01" then copy both columns to a sheet 2 and if sheet 1 columns 2 and 4 contain "copy 02" then copy both columns to a sheet 3 etc.
I can count rows fine using the code, but can't count columns. Seems to relate to not fiding the column range but I have no ideas to fix this! Any help would be much appreciated.
'Row
Dim NR As Long
Dim d As Variant
d = ws1.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For NR = 1 To UBound(d, 1)
'column
Dim NC As Long
Dim e As Variant
e = ws1.Range(Cells(1, Columns.Count).End(xlToLeft).Column).Value
For NC = 1 To UBound(e, 1)
Thanks,
Stewart
You want this:
e = range("A1:" & split(cells(1,cells(1,columns.Count).end(xlToLeft).column).address(true,false), "$")(0) & "1").Address
The cells(1, columns.count).end(xlToLeft).column) gets the last column number (for example 13 for 'M').
Putting this into cells(1, lastcolNum) gets a cell that represents the cell in the first row of this column (for example Cell M1).
The address(true, false) method gets the cell reference with a dollar sign before the row but not before the column letter (for example "M$1"
The split function returns an array which splits the input string by the "$" character (for example array - ("M","1")
The (0) returns the 0th element in the returned array (for example "M")
Then putting this into the range function returns the range (for example) "A1:M1"
I'm not entirely sure what you're trying to do with the UBound function here. It would make more sense to make
e = cells(1,columns.count).end(xlToLeft).column
and then loop through
For N = 1 To e
As this will loop through each column.
I have a little problem, I occasionally bump into this kind of problem, but I haven’t found a fast solution so far.
So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column ’A’ with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:
3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2
Now in the next step I would like to collect these numbers into another column (for example, column ’B’) using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:
3
6
4
23
2
I have already written the following code, but I’m stuck at this point.
Sub collect()
For i = 1 To 10
if cells(i,1)<>"" then...
Next i
End Sub
Is there an easy way to solve this problem?
Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:
The VBA equivalent is
Sub test()
With Sheet1
.Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
End With
End Sub
You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.
Edit: needed constants not formulas.
This will work for any number of rows that you select. It will always output in the next column at the start of your selection e.g. if data starts in B10 it will ooutput in C10
Sub RemoveBlanks()
Dim cl As Range, cnt As Long
cnt = 0
For Each cl In Selection
If Not cl = vbNullString Then
Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
cnt = cnt + 1
End If
Next cl
End Sub
If you wish to loop manually and don't mind specifying the maximum row limit;
Dim i As long, values As long
For i = 1 To 10
If cells(i, 1).Value <> "" Then
values = (values + 1)
' // Adjacent column target
cells(values, 2).value = cells(i, 1).value
End If
Next i