I'm looking for a macro to delete duplicates in a column, regarding their last value
e.g.
DES_FFAs_556
asda_FRF_556
Because 556 is same, it should be deleted.
right now im getting the last 4 digits of each cell but i dont know how to remove duplicates with it
Sub duplicates()
Dim i As Long
Dim res As String
Dim WB As Workbook
Dim WS As Worksheet
Dim total As Long
Set WB = Workbooks("MQB37W - SW Architecture Matrix_Nw")
Set WS = WB.Sheets("SW Architecture Main - In...")
With WS
total = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To total
res = Right(Cells(i, "A").Value, 4)
WS.Range("A4:total").RemoveDuplicates Columns:=1, Header:=xlNo
Next
End With
End Sub
You do not need VBA for this. You can just use code from this tutorial in a new column and than based on that column you can filter, conditional format or delete rows. If you would like to indicate only rows after the first occurrence you can use COUNTIF. Ofcourse if you need VBA for something else you can apply the same logic I described above inside the VBA code.
Related
I am working on a vba small code which extract date from Column A into Column C. the current code puts the formulas to extract date from Cell C2 to C2500, However if the data in Column A ends at line A600 it still goes down till C2500. Is it possible if we amend the code to stop pasting the formula exactly at the last line of Column A. so that i do not need to manually delete those cells "#Value". e.g. see print shot.
Sub Formula_property()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Sheets("Sheet3")
wb.Activate
ws.Select
Range("C2:C2500").Formula = "=extractDate(A2:A2)"
End Sub
Assuming that all columns have the same number of rows (except column B which is empty) - we can use CurrentRegion to get the size of the target "for free"
Sub formula()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet3")
Dim rg As Range
Set rg = ws.Range("A1").CurrentRegion
Set rg = rg.Columns(1)
With rg
.Offset(1, 1).Resize(.Rows.Count - 1).formula = "=extractDate(A2:A2)"
End With
End Sub
BTW: activate/select is not necessary - I recommend reading How to avoid using select.
I would like to write a macro to delete all records from my Excel table, except for the first row (as that's where several formulas as stored. The number of records in my table is changing, so it needs to be flexible. I am currently using the following code:
Sheets("5. Informatieproducten Index").Select
Range("A6").Select
Range(Selection, Selection.End(xlDown)).Delete
Please help!.
Tnx
By detecting the last row and last column of your data :
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
LastCol = Range("A2").CurrentRegion.Columns.Count
Range(Cells(2,1),Cells(LastRow,LastCol)).Clear
You can do it as follows:
Sheets("5. Informatieproducten Index").Range("A2:XFD1048576").Delete
This deletes the information of all cells, from A2 (just under the first row) to XFD1048576 (which is the most right-bottom cell possible).
There are so many diferent ways to do that. Before all you need to declare a variable to always look for the last row of you table. Then the next step is to look all the lines below the first row of your table and the last row that you previously declared. Note that you can clean or delete the rows. Obs: clean is the method that you keeps the format of your cell and table. Delete is the method that you remove all the formats.
Sub deleteRows()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Integer
Dim firstRow As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets("5. Informatieproducten Index")
'first Row of your table - you can do diferents things to take always the first row of your table
firstRow = ws.Range("A5").Row
'you need to take care if there is any blank cell in the interval
lastRow = ws.Range("A5").End(xlDown).Row
ws.Range("A" & firstRow & ":A9" & lastRow).EntireRow.Delete
End Sub
Im working in a code in excel vba, to delete the rows if length value of a cell is not equal to 10
Im trying to avoid using filters bcause im using a file that contains like 1 millions of rows, and when using filters, the excel crash it.
this is what I need
For exemple
The Column A contain an ID numbers,
but if the length cell with the ID is not 10 characters
I want to delete the row, this row I doesn't need it
I searched around the forums and gathered some codes to create the following code
Sub DeleteRows()
Dim c As Range
Dim LR As Integer
Dim i As Integer
Dim sht As Worksheet
Set sht = Worksheets(2)
LR = sht.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LR
For Each c In sht.Range("A2:A" & LR).Cells
If Len(c.Value) <> 10 Then
c.EntireRow.Delete
End If '<---------here is the error
Next
Next
Range("A1").Select
End Sub
when the macro is running it get stuck, I have to press ESC to stop the macro and the error appears in the line End If
This macro delete the rows that are not meeting the condition of length when I press the ESC button
Is there a solution in this code?
or exist better metod to delete rows without using the filters?
Since you're deleting rows you should really be counting upward, since it will mess your count up. For example, i is on row 3 and then deletes row 3, now row 4 is in row 3, and i is going to continue on what used to be row 5. So instead work your way from the bottom up.
Sub DeleteRows()
Dim LR As Long
Dim i As Long
Dim sht As Worksheet
Set sht = Worksheets(2)
LR = sht.Cells(Rows.Count, "A").End(xlUp).Row
For i = LR to 2 Step -1
If Len(sht.cells(i,1).value)<>10 then
sht.Rows(i).delete
End If
Next
Range("A1").Select
End Sub
So I have a big excel sheet with a bunch of empty cells in various locations. I want an easy to work with list of which cells are empty. I was hoping to make a new worksheet that was populated with the locations of the empty cells. I wanted to have this to just populate the cells I want it to. I kept the header from the worksheet I will be checking and added a blank cells count, so I want the following cells in the column to be populated by the list of empty cell locations.
Now I know I can use =ISBLANK to test if a cell is empty or not, but I only care about the cells that return TRUE. So I figure I'll need a loop. And I want the location of the cell so I can use =CELL. And to make this most readable I want to do this on a column by column basis.
But I want to populate a spreadsheet with this information in a manner similar to how functions work (I just want to copy and paste it to other cells and columns). But it's pretty clear that I am going to need VBA.
My question is how can I create a macro to populate my spreadsheet with a list of empty cells? How do I apply it to the cells?
I assume you have data in sheet1, I have used sample range// Range("A1:c15") however you can define range as per need and blank cells address will be published in next sheet.
Sub FindBlank()
Dim rng As Range
dim i as long
For Each rng In Sheet1.Range("A1:c15").SpecialCells(xlCellTypeBlanks)
i = i + 1
Sheet2.Cells(i, 1) = rng.Address
Next
End Sub
If you want a list of the cells that are empty, you can use Range().SpecialCells(xlCellTypeBlank):
Sub getEmptyCellAddresses()
Dim rng As Range
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15").SpecialCells(xlCellTypeBlanks) ' Edit/change range as necessary
ws.Cells(1, 2).Value = rng.Cells.Address ' Change `ws.cells(1, 2)` to whatever destination you like
End Sub
Edit: Ah, beaten by 16 seconds by #RamAnuragi ...but anyways, they're slightly different ways to tackle the question so I'll leave it.
Edit: For funsies, here's another way to put them all in a column, one row per cell...and more, per your comments.
Sub listEmptyCells()
Dim emptyAddresses() As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15")
If WorksheetFunction.CountBlank(rng) = 0 Then
MsgBox ("No empty cells in the range")
Exit Sub
End If
emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
For i = LBound(emptyAddresses) To UBound(emptyAddresses)
ws.Cells(i + 1, 2).Value = emptyAddresses(i)
Next i
End Sub
I'm tyring to look for a way to return a range of cells with just the lookup function. Is this really possible?
Basically like this:
=LOOKUP([MasterBook.xlsm]Sheet3!$A:$A,?)
I just want the function to look in the main workbook through all of Column A and return all cells for Column A that have something in them.
EDIT for poster below:
Sure. I have two workbooks; one workbook is essentially a local product that has a "master" sheet on top and then individual worksheets following it that have all of their information extracted from the master sheet. The second workbook is a local copy of a product that I send to a non-local entity higher up the food chain. Basically I need to pull information from the individual sheets in my first workbook and put it in the appropriate columns in the second workbook. I have a macro that gets the info from my sheets in the one workbook over to the other, but the second workbook is formatted differently. I was looking for a way to use a formula if possible.
The macro I am referring to is:
Sub CopyTest()
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Local Workbook.xlsm").Worksheets("Sheet3").Columns("A")
Set targetColumn = Workbooks("Nonlocal Workbook.xlsm").Worksheets("Sheet1").Columns("A")
sourceColumn.Copy Destination:=targetColumn
End Sub
All this does is pull the specified column from one sheet and put it in the column on the second book; but it just pastes it starting in the first block. Since the non-local book is formatted differently, the column I need to transfer to doesn't start until Row 9. shrug I have ideas abuot what I'm trying to do with this, but my ideas tend to exceed my technical ability (which occasionally makes it difficult to explain). :)
Depending on how different your workbooks are formatted. Here is two way to handle this:
Adapt your macro
Instead of copying the whole column, you can copy paste, only the values you want to.
Here is an example:
Sub CopyTest()
Dim rSource As Range, rTarget As Range
Dim lEnd As Long
lEnd = Range("A65536").End(xlUp).Row
Set rSource = Workbooks("Local Workbook.xlsm").Worksheets("Sheet3").Range("A1:A" & lEnd)
Set rTarget = Workbooks("Nonlocal Workbook.xlsm").Worksheets("Sheet1").Range("A9")
rSource.Copy Destination:=rTarget
End Sub
Use a formula
If your data are not in the same order, you'd better use a VLOOKUP formula.
See how it works.
Don't hesitate to post another question with what you've built for some help. Please give as much details as possible so we could help you the best way.
[EDIT] Another try following the comments
Option Explicit
Dim wTarget As Workbook
Sub mainCopy()
Dim bGo As Boolean
bGo = True
'Add a new workbook to copy the data - do you want the user to select one?
Set wTarget = Application.Workbooks.Add()
Do While bGo
CopyTest
bGo = MsgBox("Do you want to import data from another workbook?", vbYesNo, "Continue?")
Loop
End Sub
Sub CopyTest()
Dim rSource As Range, rTarget As Range
Dim lEnd As Long, lCol As Long
Dim ws As Worksheet
Dim vFile As Variant
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
For Each ws In ActiveWorkbook.Worksheets
'do you need to copy the columns separately?
' For lCol = 1 To 10
'find the last cell of the 10th column
lEnd = ws.Cells(65536, 10).End(xlUp).Row
Set rSource = ws.Range("A1:J" & lEnd)
'How can we define the target worksheet?
Set rTarget = wTarget.Worksheets("Sheet1").Range("A9")
rSource.Copy Destination:=rTarget
' Next lCol
Next ws
End Sub