Separating duplicate values VBA - excel

I have a worksheet that contains 3 columns: name, city and education.
In column A (Names) I have duplicate values.
I want to separate it from other duplicate values in column A something like this shown in image below below.
Is it possible using VBA?

This code will add a blank row where Names is different. Assume Names in column A:
Sub SeparateDuplicates()
Dim lastCell As Integer
lastCell = Range("A" & Rows.Count).End(xlUp).Row
For i = lastCell To 2 Step -1
If Range("A" & i) <> Range("A" & i).Offset(-1, 0) Then
Range("A" & i & ":C" & i).Insert Shift:=xlDown
End If
Next i
End Sub

Excel has alredy has remove duplicates option on the ribbon. Data->RemoveDuplicates. You can also do this with advanced filters.
If you need to do it with VBA, for example:
Sub RemoveDuplicates()
ActiveSheet.Range("$A$1:$A$5").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Where you need to put your range and your column.
A very useful tool to retrieve VBA code for determined action is the macro recorder, in the ribbon, Developer -> RecordMacro, perform you action and stop recording and then you can check the code generated for the actions you recorded. Its not the cleanest code but you can find there the lines of code for the specific actions you want.
Hope that helps

Related

How can I use VBA to copy values in a column given a condition in another column into a different sheet with no gaps in the data?

I have a table with 15 columns. I'm trying to copy and paste 3 of the columns into another sheet and then duplicate that info below itself in the destination sheet a specified number of times based on the number layers in the test I'm conducting. I'm having trouble with the code finding the bottom row of the copied data and I haven't found code that will eliminate the gaps in the data.
this is my first post so I cant add pictures yet.
here's my current code for the button that is supposed to populate the destination sheet:
Private Sub PRTButton_Click()
CopyInfo
PasteInfo
End Sub
Sub CopyInfo()
Dim aLastRow As Long
aLastRow = Sheets("Test Ammo").Cells(Rows.Count, 1).End(xlUp).Row
'ammo description
Sheets("PRT Endurance").Range("B6:B" & aLastRow - 1).Value = Sheets("Test Ammo").Range("O64:O113" & aLastRow).Value
'Ammo Spec
Sheets("PRT Endurance").Range("C6:C" & aLastRow - 1).Value = Sheets("Test Ammo").Range("C64:c113" & aLastRow).Value
'QTY Shot
Sheets("PRT Endurance").Range("D6:D" & aLastRow - 1).Value = Sheets("Test Ammo").Range("N64:N113" & aLastRow).Value
End Sub
Sub PasteInfo()
Dim LRow As Long
With ActiveSheet
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Range("B6:D" & LRow).Copy
MsgBox "Info is already in clipboard. Select your layers from the dropdown and paste at the bottom of the copied info for each layer."
End Sub
I know i haven't told the code to only copy the values with a number in the M column and paste them into the destination sheet. for reference, I only want to copy the rows that have a value in the M column in my origin sheet. I'm not sure how to tell the code to select the 3 row dynamic range in the destination sheet and paste it a certain amount of times below it.
If I missed any explanations or there's any confusion, let me know and I'll try to clarify.
Origin table
Table after pressing "Populate ammo info"

Apply VLOOKUP on next visible cell

The below code does vlookup then autofills the data then applies the filter to #N/A. Here I need to do another VLOOKUP in the same column with the filter as #N/A but I am not sure about this as how do we select the cells below F1 and apply VLOOKUP on the visible data. Could you help me out with this?
Sub Vlookup()
Worksheets("error rate").Activate
Range("F2") = "=Vlookup(B2,'sales'!B:C,2,0)"
Range("F2").Select
Range("F2").AutoFill Range("F2:F" & Range("B" & Rows.Count).End(xlUp).Row)
Range("F:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("B1").AutoFilter Field:=6, Criteria1:="#N/A"
Range = Rng.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 6)
End Sub
Few things
Avoid using Activate/Select. You may want to see How to avoid using Select in Excel VBA
Define and work with objects. Becomes much easier to work with your code.
Instead of entering formula in one cell and then autofilling it, simply enter the formula in the entire range in one go as shown below.
I see the objective is to get all the values. Then there is no need to enter a formula, filter and renter the formula. Use a single nested formula using IFERROR and IF. For example, if the formula "=Vlookup(B2,'sales'!B:C,2,0)" doesn't give you the result and you want to pull up the values from say column D then use the formula =IFERROR(VLOOKUP(B2,Sales!B:C,2,0),VLOOKUP(B2,Sales!B:D,3,0)). I have simply nested VLOOKUP(B2,Sales!B:D,3,0) inside IFERROR(). What the formula does is checks if there is an error with VLOOKUP(B2,Sales!B:C,2,0) and if there is, then it attempts to find the value using VLOOKUP(B2,Sales!B:D,3,0)
CODE
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Set this to the relevant sheet
Set ws = ThisWorkbook.Sheets("error rate")
With ws
'~~> Find last row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
'~~> Work with the relevant range
With .Range("F2:F" & lRow)
'~~> Enter the formula in the entire range in one go
.Formula = "=IFERROR(VLOOKUP(B2,Sales!B:C,2,0),VLOOKUP(B2,Sales!B:D,3,0))"
'~~> OPTIONAL
'~~> Instead of copy and paste as values use this.
'.Value = .Value
End With
End With
End Sub

Debug countif and autofill in excel VBA, criteria doesn't work

I will need a function to count the number of each item in column J and show the result on column K. But this code I show below keep saying that the criteria part RC[-2] is wrong. After the countif function, I will need it to be able to autofill in whatever lines are given so that I can apply this code to other files as well.
I used Macro to generate some code to start. And also try this earlier:
paste_countPTD = Worksheetfunction.CountIf(paste_conPTD,RC[-2]).
The criteria part seemed wrong.
Dim paste_conPTD As Range
Set paste_conYTD = Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row)
Range("K1").Select
ActiveCell.FormulaR1C1 = "Count_PTD"
Range("K2").Worksheetfunction.countif(paste_conPTD,RC[-2])
I appreciate any suggestion to make this code works. To do the countif for a column and autofill the formula.
You can try this code
Dim paste_conPTD As Range
Set paste_conYTD = Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row)
Range("K1") = "Count_PTD"
Dim iRng as Range
For each iRng in paste_conPTD
iRng.Offset(0,1) = Worksheetfunction.Countif(paste_conPTD, iRng)
Next iRng
To give you some notes, we need to iterate over each cells in the paste_conYTD range, that is where iRng comes in. We can't tell Excel like paste_conYTD = <some formula> and assume Excel knows we want it to compute for each cells using the formula. Excel iteration comes in a few ways, we can choose one that is easiest to apply based on scenario.
For each ... in ... Next
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/for-eachnext-statement
For ... Next
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/fornext-statement
Do... Loop
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/doloop-statement
While... Wend
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/whilewend-statement
If you want the actual formula in the cells try this.
Dim paste_conPTD As Range
Set paste_conYTD = Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row)
Range("K1").Value = "Count_PTD"
paste_conYTD.Offset(, 1).FormulaR1C1 = "=COUNTIF(" & paste_conYTD.Address(ReferenceStyle:=xlR1C1) & ",RC[-2])"

Move data from multiple columns into single row

This formatting issue is confusing me. I'm not an Excel king and would greatly appreciate the solution to my problem.
I'm trying to format data from multiple columns into a single row by date. i.e.:
I've tried to search for solutions regarding transpose, but this seems a bit more involved. I have 4x data results for each date (as seen in the before column).
Here is a simple loop that works bottom up in the sheet, shifts last line over 4 columns, copies line above down and then deletes the line above.
Sub TransposeData()
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Set WS = Worksheets("Sheet1")
With WS
Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
LastCellRowNumber = LastCell.Row
End With
'Loop through column A bottom up
For i = LastCellRowNumber To 2 Step -1
'Shift current values over
Range("A" & i & ":D" & i).Insert Shift:=xlToRight
'Copy new values down
Range("A" & i & ":D" & i).Value = Range("A" & i - 1 & ":D" & i - 1).Value
'Delete row
Rows(i - 1).Delete Shift:=xlUp
Next i
End Sub
Before:
After:
You can use NotePad++ to unite the rows as from a .csv file, and then, import the new formatted information on Excel again.
1- Save your spreadsheet in comma separated value format (.csv).
2- In NotePad++, click on: Edit->Line Operations->Join Lines.
3- Replace spaces (" ") by commas(","). You should get 3 replacements.
Now you have just one line with all values separated by commas.
4- Save and import this new file on Excel.
As per this, there are several options:
Item 3: enter in A8
=OFFSET($A$2,INT((COLUMN()-COLUMN($A$8))/4),MOD(COLUMN()-COLUMN($A$8),4))
Copy to the right as needed.
You could also use INDEX.

Find a value and .filldown over multiple subsequent ranges?

VBA newbie here. I have a dynamic list of multiple groups. Each group lists the leader of the group at the top with the members of the group below. There is a primary key in Column A next to each listed person. I want to take the leader's key # and apply it to Column F for the leader and each member of the group, such that each member has their own primary key # in Column A and is associated with their leader's primary key # in Column F. Here are two images of what I need for the before and after:
Before
After
Here is the code I am playing around with conceptually:
Sub Apply_Leader_Code()
Dim wSht As Worksheet
Dim lStart As Long, lEnd As Long, lLdrID As Long
Set wSht = ThisWorkbook.Sheets("Upload")
With wSht.Range("A1:G" & Range("A" & Rows.Count).End(xlUp).Row)
lStart = .Rows.Find("78") 'Find the first row for each group
lEnd = .Rows.FindNext("78") - 1 'Find the last row for each group
If .Range("G" & lStart & ":G" & lEnd).Value = "" Then
'If there is no leader ID yet, then continue...
lLdrID = .Cells(lStart, 1).Value 'Assign leader's primary key to the variable
.Cells(lStart, 7).Value = lLdrID 'Place lLdrID value into Column G
.Range("F" & lStart & ":F" & lEnd).FillDown 'Fill value to end of group range
Else
'..otherwise, set start/end rows for next group.
lStart = .Rows.FindNext("Leader")
lEnd = .Rows.FindNext("Leader") - 1
End If
End With
End Sub
The above code isn't actually applicable, but I hope represents what I think is a reasonable way to solve this problem. I can (maybe?) figure out how to do this for the first group, but how do I then perform the same .FillDown function for each subsequent group?
--EDIT--
In regards to Siddarth Rout's answer below, here is my newer code:
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=78,RC[-6],R[-1]C)"
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G" & Range("G" & Rows.Count).End(xlUp).Row)
I used the Macro creator in Excel and then edited it to what I thought would enable it to have a dynamic range instead of a set range. Now I'm getting a 400 error. Any ideas why? Any ideas on how to input the formulas w/o "selecting" the range? I am gathering that many programmers think that selecting cells is bad programming...
Do you need VBA for this? This can be achieved using excel formulas
Formula in Cell G2
=A2
Formula in Cell G3
=IF(F3=78,A3,G2)
now simply copy the formula from G3 down to G14
If you still need VBA then simply record a macro for the above steps and amend it :)
FOLLOWUP (From Comments)
Yes .Select should be avoided.
INTERESTING READ
Also no need to use R1C1 format. You can directly specify the formula
And one more thing. You don't need to use Autofill. You can skip that step by directly filling all the relevant cells with the relevant formula in ONE GO
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find the last cell in Col A which has data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Enter first formula
.Range("G2").Formula = "=A2"
'~~> Enter 2nd formula in all the
'~~> cells in one go rather than autofill
.Range("G3:G" & lRow).Formula = "=IF(F3=78,A3,G2)"
End With
End Sub

Resources