I have tried, and been unable to find any sample VBA code that fits my needs. What I'm trying to do is find duplicate matches between two columns and consolidate them with respect to a third column, then in a fourth column show how many instances of the duplicate existed originally.
The original data:
The ideal output after removing duplicates:
As you can see, in the output I have 1 instance of 1 in Column A, a in Column B, retained the first value the duplicates started at in Column C and express 2 occurences of the duplicates in Column D. Can anyone point me in the right direction? Any help would be greatly appreciated.
the below code will find the number of occurrences in fourth column and remove the duplicates
Sub foo()
row_count = 20
For i = 2 To row_count
Count = 1
For j = 2 To row_count
If i <> j And Cells(i, 1).Value <> "" Then
If Cells(i, 1).Value = Cells(j, 1).Value And Cells(i, 2).Value = Cells(j, 2).Value Then
Rows(j & ":" & j).Delete Shift:=xlUp
Count = Count + 1
j = j - 1
End If
End If
Next j
If Count > 1 Then
Cells(i, 4).Value = Count
End If
Next i
End Sub
Related
I just started to learn Excel VBA so bear with me here, I have a column of ID numbers and I already figured out how to generate numbers from 1 to the end of a list as follow 1,2,3,4 etc.
The problem is how can I generate a list of ID numbers like this 1,1,2,2,3,3 etc (row 1 and row 2 should have the same incremented number)
Here is what I did to increment numbers by 1 :
Sub AddingNbr()
Columns("A").Insert
Range("A1").Value = "ID"
For i = 1 To Range("B2", Range("B2").End(xlDown)).Count
Cells(i + 1, 1).Value = i
Next
End Sub
Can you try this?
Sub AddingNbr()
Columns("A").Insert copyorigin:=xlFormatFromRightOrBelow
Range("A1").Value = "ID"
For i = 1 To Range("B2", Range("B2").End(xlDown)).Count
Cells(i + 1, 1).Value = WorksheetFunction.Ceiling(CDec(i) / CDec(2), 1)
Next
End Sub
well all this is fine, but I have a nice way to do incrementation of values in excel with the one format we want. This formula really helps espacially when you want to use forms. That's the formula:
="LIVR"&TEXT(IF(A1=$A$1;0;MID(A1;5;3)+1);"000") it makes that
LIVR000
LIVR001
LIVR002
LIVR003
...
LIVR999
This question already has answers here:
VBA macro to delete rows quickly
(4 answers)
Closed 6 years ago.
I have to delete all rows that have to cells equal in VBA excel. Here is what i wrote:
Dim i As Long, j As Long
j = Rows.Count
For i = 1 To j
If Cells(i, 17).Value = Cells(i, 19).Value Then Rows(i).Delete
Next i
But this code is not deleting every line I am looking for. If there are 2 rows with matches the conditions respectively, Excel jumps to another one and leaves this (which is logical), I do not know how to adapt this loop to coming back and delete every searched line
What I am understanding from your code is , it is not iterating all the lines since one of the conditions are getting fulfilled .
My recommendation is to reverse loop it. Iterate from the last by using "-1"
Instead of:
For i = 1 To j
If Cells(i, 17).Value = Cells(i, 19).Value Then Rows(i).Delete
Next i
Do this:
For i = j to 1 Step - 1
If Cells(i, 17).Value = Cells(i, 19).Value Then Rows(i).Delete
Next i
When you delete a row you have to decrement the value of i and update the value of j.
Because when you delete a row:
the following row is now at the i position
the number of rows (j) is reduced by 1 row
I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.
this is my first attempt to create a macro, so sorry in advance for my lack of knowledge on the subject. I've attempted to follow tutorials and examples online, but I'm not having a lot of luck.
I want to create a macro that can move an entire row above the previous row if certain values in the row are less than the respective values in the previous row.
I tried posting an image of the excel sheet I'm working with, but I do not have enough reputation.
The logic would be something like this:
IF--- Column2(row_i) < Column2(row_i-1)
AND--- Column3(row_i) < Column4(row_i-1)
THEN
Insert a blank row above row_i-1
Copy row_i and paste it in the blank row
Delete the original row_i
Return to top of list and begin search again
ELSE--- Move to row_i+1}
Here is what I currently have:
Sub PrioritySort()
Dim i As Integer
For i = 11 To 17
If Cells(i, 2) < Cells((i - 1), 2) Then
If Cells(i, 3) < Cells((i - 1), 4) Then
//insert row_i above row_i-1
Else
Next i
End Sub
If anyone would be willing to help, it'd be greatly appreciated!
//insert row_i above row_i-1 is something like:
Rows(i).Select
Selection.Cut
Rows(i-1).Select
Selection.Insert Shift:=xlDown
...Also remember an "End If" to close out your multiline If statements.
Let's take a sample:
column1 column2 column3 column4
4 4 4 4
3 3 3 3
2 2 2 2
1 1 1 1
We want to reordering this. Our end result should look like this
column1 column2 column3 column4
1 1 1 1
2 2 2 2
3 3 3 3
4 4 4 4
Macro
Sub Macro3()
Dim NoOfTimesChanged As Integer
' attempt to reorder rows and find out if reordering
' was done or not
NoOfTimesChanged = ReOrderRows()
' keep on reording until there is nothing else to reorder
Do While NoOfTimesChanged > 0
NoOfTimesChanged = ReOrderRows()
Loop
End Sub
Function
' Reorder all rows based on certain condition
' Returns: 0 or 1 to the caller
' 0 is returned when no reording was necessary
' 1 is returned when reordering was necessary
Function ReOrderRows() As Integer
Dim ReOrdered As Integer
ReOrdered = 0
' Lets start from row #3 and compare with row #2
' Remember that row #1 has headers
For i = 3 To 5
' IF--- Column2(row_i) < Column2(row_i-1)
' AND--- Column3(row_i) < Column4(row_i-1)
If Cells(i, 2) < Cells(i - 1, 2) And _
Cells(i, 3) < Cells(i - 1, 4) Then
' select the current row and cut it
Rows(i & ":" & i).Select
Selection.Cut
' select the above row insert the cut-rows
' making sure the current selection is moved down
Rows(i - 1 & ":" & i - 1).Select
Selection.Insert shift:=xlDown
' mark this flag to 1 so as to inform
' the caller function that reordering
' was performed
ReOrdered = 1
End If
Next i
ReOrderRows = ReOrdered
End Function
Try this out. Note that I have used only 4 rows + 1 header row and therefore the for loop goes from 3 to 5. You can change this code as you desire.
I am looking for code to loop through 2 columns and one row.
i- row, j and r - columns
Here 2 tables with 7 columns starting from 13 till 20 and 237 till 244.
Based on values in 2 table I want to select cell in first table.
I want to first select Cells(i, j).Select and check for value Cells(i, r).Value and paste or comment in Cells(i, j)
For i = 2 to Cells(Rows.Count, "c").End(xlUp).Row
For j = 13 To 27
For r = 237 To 244
Let me know for solution to this. Thanks in advance.
Looking at your question it seems that you need answer for "How to refer adjacent cells?"
For that you can use Offset() property in excel vba.
It works like this:
Assume you are referring to Row no. 1 (i.e. i=1) and column j.
Now you want to refer same row but column r; you can use:
Range("Your_Range").Offset(0, 7).Select
I found the logic myself, Thanks all for looking into this.
Here is the logic:
r = 237
For i = 10 To Cells(Rows.Count, "c").End(xlUp).Row
For j = 13 To 20
If Cells(i, r).Value = "A" Then
Cells(i, j).Select
r = r + 1
Next j
r = 237
Next i