I Know how to build a loop macro to read all of the rows in a certain column, but what I do not know how to do is write it in such a way that it will select the data not in common and that may not sound correct so here is an excample:
column A
1
1
1
1
2
2
2
2
3
3
3
What I want is for the loop to look at column A but only the first row of the new data so it would look like this
Column A
1
2
3
Thank you,
Give this a try:
Sub Macro1()
Dim A As Range
Set A = Range(Range("A1"), Range("A" & Cells(Rows.Count, "A").End(xlUp).Row))
A.RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
EDIT#1:
This will first copy to another sheet and then remove duplicates in the copy:
Sub Macro1()
Dim A As Range, B As Range
Set A = Range(Range("A1"), Range("A" & Cells(Rows.Count, "A").End(xlUp).Row))
Set B = Sheets("Sheet2").Range("A1:A" & A.Rows.Count)
A.Copy B
B.RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Related
I have a spreadsheet that looks something like this:
A B C D E F
1 Program Year Cycle Date Panel Mtg Rep
2 AAA 2019 1 5/21 ABA Tom
3 AAA 2019 1 5/23 ABB Erin
4
5 BBB 2019 2 6/4 BAB Jim
6
7 CCC 2019 3 7/16 CAB Tom
8 CCC 2019 4 8/27 CBB Kate
9
10
What I'm trying to have it do is, every time a row is skipped, that blank row will automatically be populated with the column headings. So in the example table above, rows 4 and 6 would contain the column headings, while row 9 would remain blank until information was entered on row 10. I've done every possible search I can think of, and haven't found anything that seems applicable. I'm not very familiar with VBA, so I came up with the following series of formulas:
A3) =IF(AND($A2<>"",$A4<>"",$A2<>$A$1),$A$1,"")
B3) =IF(A3=A$1,B$1,"")
C3) =IF(B3=B$1,C$1,"")
D3) =IF(C3=C$1,D$1,"")
E3) =IF(D3=D$1,E$1,"")
F3) =IF(E3=E$1,F$1,"")
These formulas are then extended to the rest of the sheet. This does what I want it to do, but it also fills 8,000+ cells with formulas, including circular references. Which, aside from having to deal with being alerted to the circular references, they also affect other aspects of my sheet, such as conditional formatting, identifying duplicate entries, etc.
As I stated, I'm not really very familiar with VBA, so I don't even know if this is doable using VBA. But if there is some way to achieve the same result without formulas, or at least without circular references, that is what I'm looking for. Thanks so much for any assistance.
This code should work:
see before:
and after:
Sub addHeaders()
Dim ws As Worksheet
Set ws = Sheets("Sheet3")
Dim lastRow As Integer
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim header As Range
Set header = ws.Range("A1:F1")
For rowNum = 2 To lastRow
If ws.Cells(rowNum, 1) = "" Then
If ws.Cells(rowNum + 1, 1) <> "" Then
ws.Range("A" & rowNum & ":F" & rowNum) = header.Value
End If
End If
Next rowNum
End Sub
Since you said you are new to vba here is quick quick intro to how to run a program:
Something like this is what you're looking for:
Sub tgr()
Dim ws As Worksheet
Dim rHeaders As Range
Dim rDest As Range
Dim ACell As Range
Set ws = ActiveWorkbook.ActiveSheet
Set rHeaders = ws.Range("A1:F1")
For Each ACell In ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).Cells
If Len(Trim(ACell.Value)) = 0 Then
If Not rDest Is Nothing Then
Set rDest = Union(rDest, ACell)
Else
Set rDest = ACell
End If
End If
Next ACell
If Not rDest Is Nothing Then rHeaders.Copy rDest
End Sub
I have data to copy from sheet 1 ("Invoice") to sheet 2 ("Inventory"). I only need to copy 1 cell consist of numbers of Invoice ("1,2,3,etc").
I already succeed copy (Invoice.D14) and paste the cells (Inventory.B4) however i need to autofill as far as another column (Inventory.D4) in sheet 2 ("Inventory"). Please see my code as follow :
Dim Outgoing As Worksheet
Dim Invoice As Worksheet
Set Outgoing = ActiveWorkbook.Worksheets("Inventory")
Set Invoice = ActiveWorkbook.Worksheets("Invoice")
Invoice.Range("D14").Copy
Outgoing.Cells(Rows.Count, 1).Range("B1").End(xlUp).Offset(1, 0).PasteSpecial
With Range("B4").Resize(4)
.Value = [B4]
.AutoFill .Resize(Range("C" & Rows.Count).End(xlUp).Row - 1)
End With
It keeps coming with error message.
Anyone can help?
EDIT MESSAGE
I already copied from sheet 1 ("Invoice") to sheet 2 ("Inventory").
On sheet 1 ("Invoice") contains :
Data code with range from B21 until B27
Transaction ID with cell D14
I copy above data to sheet 2 ("Inventory") with detail :
Data code copy to Inventory.columnD (start row at 4)
Transaction ID copy to inventory.columnB (start row at 4)
If i input 3 code on data code it will copy to Inventory with 3 code as well (3 rows), however since i only copy 1 cell for transaction ID the output on Inventory only 1 cell as well.
What i need is to autofill the transaction ID as long as data code that i input previously. However, if i'm using autofill i don't know why it's always shown error message. So i try a different way, to copy the first transaction ID.
I try below code as well :
Sub Outgoing_Data()
Dim Inventory As Worksheet
Dim Invoice As Worksheet
Dim columnB As Range
Dim columnD As Range
Dim c As Range
Dim i As Long
Dim lastNonEmptyRow As Range
Set Outgoing = Worksheets("Inventory")
Set Invoice = Worksheets("Invoice")
Set columnB = Range("B:B")
Set columnD = Range("D:D")
Invoice.Range("B21:B27").Copy
Outgoing.Cells(Rows.Count, 1).Range("D1").End(xlUp).Offset(1, 0).PasteSpecial
Invoice.Range("D14").Copy
Outgoing.Cells(Rows.Count, 1).Range("B1").End(xlUp).Offset(1, 0).PasteSpecial
i = 5
Set lastNonEmptyRow = Outgoing.Range(Cells(i - 1, 2), Cells(i - 1, 2))
For Each c In columnD.Cells
If c.Value2 = "" Then Exit For
i = i + 1
Next c
Do While columnD(i) <> ""
lastNonEmptyRow.Copy Range(Cells(i, 2), Cells(i, 2)).PasteSpecial
i = i + 1
Loop
End Sub
The output that i want it :
| transaction_ID | Product ID
| 1 | 2DFGH4
| 1 | 2DFGH7
| 1 | 2HJTY0
| 2 | 1JKTY7
| 2 | 5THSD1
| 3 | 4GHTY9
(Have no idea how to draw a table in here, but hope you understand what i'm saying)
The result, transaction ID already as long as data code. For the first trial it looks fine. But when i change the transaction ID on Invoice and run it again without delete the data on Inventory, the transaction ID on Inventory only copy on 1 cell. Is there any suggestion for this?
Really appreciate your answers.
Thank you
Maybe the wrong sheet is activated? Try:
With Outgoing.Range("B4").Resize(4)
.Value = [B4]
.AutoFill .Resize(Range("C" & Rows.Count).End(xlUp).Row - 1)
End With
EDIT:
The problem with .AutoFill .Resize(Range("C" & Rows.Count).End(xlUp).Row - 1) is that Rows.Count returns absolute value of rows, counting form 1, not 4 (which is the row that you are refering to). So, if you always start autofill form B4, simple -3 will work fro you:
.AutoFill .Resize(Range("C" & Rows.Count).End(xlUp).Row - 3)
But, if this row would change dynamically, you can add this to row calculation, for example:
expectedRow = 8
With Outgoing.Range("B" & expectedRow).Resize(4)
.Value = Range("B" & expectedRow).Value
.AutoFill .Resize(Range("C" & Rows.Count).End(xlUp).Row - expectedRow + 1)
End With
By the way, I don't uderstand the purpose of this .Value = Range("B" & expectedRow).Value line and Resize(4) part of With command, but I don't know how your data looks like and what is your particular goal, so try to remove this and see if output works out for you.
your aim is not very clear
try this:
Option Explicit
Sub main()
Dim Outgoing As Worksheet
Dim Invoice As Worksheet
Set Outgoing = ActiveWorkbook.Worksheets("Inventory")
Set Invoice = ActiveWorkbook.Worksheets("Invoice")
Invoice.Range("D14").Copy
With Outgoing
With .Cells(Rows.Count, 1).Range("B1").End(xlUp).Offset(1, 0)
.PasteSpecial
.Resize(4).Value = .Value
.Resize(4).AutoFill .Resize(4, 2)
End With
End With
End Sub
I'm trying to delete entire rows in Excel 2013 but only if all cells in columns K, L and M are 0/$0.00.
Example of my data:
Excel Data Sheet
I'm wanting it to keep rows 2 - 11 as they all contain something in K, L or M. The current code that I found and have been trying to use seems to only be recognising columns L and M because it is deleting row 2 which has a figure in column K. I don't want it to calculate the totals of the 3 cells in a row because if I have a figure of $500 in column K and -$500 in column L, they'll equal to $0.00 but I need that row because there is data.
I had found 2 questions very similar to what I'm asking on this site so I tried to apply the code to what I'm doing but I must have been doing something wrong because I couldn't get it to work.
Excel VBA delete entire row if both columns B and C are blank
Delete entire row if cells in specific range are all empty
This is the code that I found and have been trying to use. Could it not be working because 1 column is positive numbers and the other 2 are negative numbers? I'm really new to using VBA etc. so I'm sorry if this is something really simple.
Sub DeleteRows()
Dim rng As Range, cel As Range
Dim N As Long
For N = rng.Rows.Count To 1 Step -1
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Set rng = ActiveSheet.Range("L1:L" & ActiveSheet.Range("L" & ActiveSheet.Rows.Count).End(xlUp).Row)
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Set rng = ActiveSheet.Range("M1:M" & ActiveSheet.Range("M" & ActiveSheet.Rows.Count).End(xlUp).Row)
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Next N
End Sub
The spread sheets that I actually work with and use every day usually contain 12,000 to 15,000 rows (file size is always about 2.5MB).
I would really appreciate any help on what I could do to make this work.
Thank you
If I understand you correctly:
Sub DeleteRows()
Dim rw As Range, r
'start on the last row
With ActiveSheet.Range("A1").CurrentRegion.EntireRow
Set rw = .Rows(.Rows.Count)
End With
Do While rw.Row > 11
r = Application.CountIf(rw.Cells(1, "K").Resize(1, 3), 0)
Set rw = rw.Offset(-1, 0)
If r = 3 Then rw.Offset(1, 0).Delete
Loop
End Sub
you may want to try this code:
Option Explicit
Sub DeleteRows()
With ActiveSheet '<--| refer to active sheet (you may want to explicitly refer to a named worksheet: 'With Worksheets("mySheet")')
With .Range("A1").CurrentRegion.Offset(, .UsedRange.Columns.Count).Resize(, 1) '<--| refer to a range in a "helper" column just outside the used range occupying the same rows as your data
.FormulaR1C1 = "=if(countif(RC11:RC13,0)=3,1,"""")" '<--| use "helper" column to mark "KLM-zero's" rows with a "1", while leaving others with a "blank" mark
If WorksheetFunction.Sum(.Cells) > 0 Then .SpecialCells(XlCellType.xlCellTypeFormulas, xlNumbers).EntireRow.Delete '<--| delete any row whose "helper" column cell is marked with "1"
.Clear '<--| clear "helper" column
End With
End With
End Sub
I need a formula or function which is going to fulfill my below mentioned need. I have a excel data of around 11000 rows and data looks somewhat like in Column A:
Now in column B i want the result to be printed like it mentioned below: which literally means it should count the values present in column A and print it in the column B, I don't need to repeat count:
Column A Column B
PC-101 1
PC-101 1
PC-102 2
PC-102 2
PC-103 3
PC-104 4
PC-106 5
PC-107 6
PC-104 4
PC-106 5
PC-106 5
I tried with the "count" series formulas but the result was null.
Even i wrote the macro as given below( which i got from stackoverflow) but even it is printing the repeating count:
Sub CountOccurence()
' Reference: Microsoft Scripting Runtime
Application.ScreenUpdating = False
Set oDict = New Dictionary
Dim wS As Worksheet
Dim r As Integer, rLast As Integer
Set wS = Sheet1
rLast = wS.Cells(1, 1).CurrentRegion.Rows.Count
For r = 3 To rLast Step 1
If Not (oDict.Exists(wS.Cells(r, 1).Value)) Then
oDict.Add wS.Cells(r, 1).Value, 1
Else
oDict.Item(wS.Cells(r, 1).Value) = oDict.Item(wS.Cells(r, 1).Value) + 1
End If
wS.Cells(r, 2).Value = oDict.Item(wS.Cells(r, 1).Value)
Next r
Set oDict = Nothing
Application.ScreenUpdating = True
End Sub
Can anyone help me regarding this? Thanks in advance.
I tried with the "count" series formulas but the result was null.
A simple Excel formula can do this.
Put 1 in Cell B1 and then put this formula in cell B2 and pull it down.
=IF(COUNTIF($A$1:$A2,A2)>1,VLOOKUP(A2,A:B,2,0),B1+1)
Assuming that your data in column a is sorted, you can simply place 1 in B2 this formula in B3 and copy it down:
=IF(A2<>A3,B2+1,B2)
:-)
Well the question is, I have got a column, for example column Y has many entries in it, nearly 40,000 and It increases everyweek. The thing is I have to check for duplicates in Y column and delete the entire row. Thus, Y column should have only unique entries.
Suppose I have 3,000 entries and after 1 week, i'll have about 3,500 entries. Now I have to check these newly added 500 columnn values not the 3,500 with the old + the new i.e 3,500 entries and delete the duplicated row. The old 3,000 shouldn't be deleted or changed. I have found macros but they do the trick for the entire column. I would like to filter the new 500 values.
Cells(2, "Q").Formula = "=COUNTIF(P$1:P1,P2)=0" 'I have used these formula
Range("Q2").Copy Destination:=Range("Q3:Q40109") 'it gives false for the duplicate values
I know we have to use countif for the duplicate entries. But what Iam doing is applying the formula and then search for false entries and then delete it. I belive applying formula and finding false and then deleting its little bit time consuming.
Sub DeleteDups()
Dim x As Long
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
End Sub
This is what I found on google but i dont know where the error is. It is deleting all the columns if i set
For x = LastRow To 1 Step -1
For x = LastRow to step 3000 ' It is deleting all 500 columns but if it is -1 working fine
Any modifications need to be done for these function? or sugest me any good function that helps me. Check for the duplicate values of a selected column range from the entire column. I mean check 500 entires column values with the 3500 column entry values and delete the duplicates in 500 entries
Thanks in advance
This should be rather simple. You need to create 1 cell somewhere in your file that you will write the cell count for column Y each week after removing all dupes.
For example, say week1 you remove dupes and you are left with a range of Y1:Y100. Your function will put "100" somewhere in your file to reference.
Next week, your function will start looking from dupes from (cell with ref number) + 1, so Y:101 to end of column. After removing dupes, the function changes the ref cell to the new count.
Here is the code:
Sub RemoveNewDupes()
'Initialize for first time running this
If Len(Range("A1").Value) = 0 Then
Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row
End If
If Range("A1").Value = 1 Then Range("A1").Value = 0
'Goodbye dupes!
ActiveSheet.Range("Y" & Range("A1").Value + 1 & ":Y" & _
Range("Y" & Rows.count).End(xlUp).row).RemoveDuplicates Columns:=1, Header:=xlNo
'Re-initialize the count for next time
Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row
End Sub
*sorry no idea why auto-syntax highlighting makes this hard to read
Update:
Here is a way to do it in Excel 2003. The trick is to loop backwards through the column so that the loop isn't destroyed when you delete a row. I use a dictionary (which I'm famous for over-using) since it allows you to check easily for dupes.
Sub RemoveNewDupes()
Dim lastRow As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
If Len(Range("A1").Value) = 0 Then
Range("A1").Value = 1
End If
lastRow = Range("Y" & Rows.count).End(xlUp).row
On Error Resume Next
For i = lastRow To Range("A1").Value Step -1
If dict.exists(Range("Y" & i).Value) = True Then
Range("Y" & i).EntireRow.Delete
End If
dict.Add Range("Y" & i).Value, 1
Next
Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row
End Sub
How can Excel know that entries are "new"? (e.g. how can we know we only have to consider the 500 last rows)
Actually, if you already executed the macro last week, the first 3,000 rows won't have any duplicates so the current execution won't change these rows.
The code your described should nearly work. If we keep it and change it very slightly:
Sub DeleteDups()
Dim x As Long
Dim LastRow As Long
LastRow = Range("Q65536").End(xlUp).Row
For x = LastRow To 1 Step -1
'parse every cell from the bottom to the top (to still count duplicates)
' and check if duplicates thanks to the formula
If Range("Q" & x).Value Then Range("Q" & x).EntireRow.Delete
Next x
End Sub
[EDIT] Another (probably faster) solution: filter first the values and then delete the visible rows:
Sub DeleteDups()
ActiveSheet.UsedRange.AutoFilter Field:=17, Criteria1:="True" 'filter column Q for True values
ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End Sub
Couldn't test this last solution right here, sorry.
Here's an idea:
Sub test
LastRow = Range("A65536").End(xlUp).Row
For i = LastRow To 1 Step -1
If Not Range("a1:a" & whateverLastRowYouWantToUse ).Find(Range("a" & i).Value, , , , , xlPrevious) Is Nothing Then
Rows(i).Delete
End If
Next i
End Sub
It checks the entire range above the current cell for a single duplicate. If found, it the current row is deleted.
EDIT I just realized in your example, you said column Y, but in your code you are checking A. Not sure if the example was just a hypothetical, but wanted to make sure that wasn't the reason for the odd behavior.
Note, this is untested! Please save your workbook before trying this!