i am trying to copy and paste unique values of a column in vba. the challenges are the: the excel doesn't have a fixed position, the position can change based on the data. As can be seen in the picture, i want to take the unique values of the amount(abs) of Columns A and paste then besides it on columns B, i don't want to touch the amounts in column A. there are a couple of empty cells between amount and absolute amount. both amount and absolute amounts are dynamic.
enter image []1 here
As i mentioned above, the tables are dynamic. if the number of amount gets bigger the amount adds a new row and the amount(abs) always keeps the two empty cells between. Any suggestions help is apperciated?
you could use RemoveDuplicates() method of Range object:
Sub Test()
With Worksheets("MySheetName") ' change "MySheetName" to your actual sheet name
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
With .Range(.Find(What:="Amount(ABS)", LookIn:=xlValues, LookAt:=xlWhole).Offset(1), .Cells(.Count))
.Offset(, 1).Value = .Value
.Offset(1).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End With
End With
End Sub
If you have access to the UNIQUE function in excel:
Determine your range of ABS Amounts using the defined variables Found and lr
Output the UNIQUE function to the right to de-dup your range
Clear the formula/spill range with a value transfer (Range.Value = Range.Value)
Sub Social_Distance()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2") '<-- Update Sheet Name
Dim Found As Range, lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set Found = ws.Range("A1:A" & lr).Find(What:="Amount(ABS)", LookIn:=xlValues, LookAt:=xlWhole)
If Not Found Is Nothing Then
Found.Offset(, 1) = "Unique Values"
Found.Offset(1, 1) = "=UNIQUE(" & ws.Range(ws.Cells(Found.Offset(1).Row, 1), ws.Cells(lr, 1)).Address(False, False) & ")"
ws.Range(ws.Cells(Found.Offset(1).Row, 2), ws.Cells(lr, 2)).Value = ws.Range(ws.Cells(Found.Offset(1).Row, 2), ws.Cells(lr, 2)).Value
End If
End Sub
Related
I am very new to VBA and am trying to create a macro that selects the cell next to a specifically named column, names it "UniqueID", has it apply a concatenate formula to the whole column, and then selects the next column over, names it "VerifyID", and has it apply a VLOOKUP to the whole column. What I'm having issues with is having the specific cell selection work. Here is what I have:
Application.CutCopyMode = False
Sheets("PowerBI Data Dump").Select
Selection.AutoFilter
Dim i As Long
Dim LastSamplePrepColumn As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1")
Set LastSamplePrepColumn = rngHeaders.Find("UniqueID")
i = LastSamplePrepColumn.Column
j = LastSamplePrepColumn.Column + 1
ActiveSheet.Cells(2, i).Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
Selection.AutoFill Destination:=Range("RC2:RC157")
ActiveSheet.Cells(1, j).Select
ActiveCell.FormulaR1C1 = "VerifyID"
ActiveSheet.Cells(2, j).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],UniqueID!C[-26],1,FALSE)"
When debugging, it errors at the last line. My main issue, however, is with having the Range().Select choosing columns by letter instead of by the name of the column. I get data dumps in a variety of formats, so I need it to be able to select a column by the name of the one next to it.
Thanks in advance for any advice.
Edit: I have changed my code to reflect where I am now. I'm still stuck on how to make the formula apply to the whole column without selecting the column by letter.
So you want to find the 'UniqueID' column and then add formulas in the two columns to the right and copy then down?
This code will do that but I think you might need to rethink the VLOOKUP formula.
For a start you can probably replace it with MATCH and if the column UniqueID is going to be in you might want to consider changing the relative column reference, i.e. -26, to an absolute reference.
Dim wsData As Worksheet
Dim LastSamplePrepColumn As Range
Dim rngHeaders As Range
Dim colID As Long
Application.CutCopyMode = False
Set wsData = Sheets("PowerBI Data Dump")
Set rngHeaders = ws.Range("1:1")
colID = Application.Match("UniqueID", rngHeaders, 0)
If Not IsError(colID) Then
With wsData
.Range(.Cells(2, colID + 1), .Cells(.Rows.Count, colID).End(xlUp).Offset(, 1)) _
.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
.Range(.Cells(2, colID + 2), .Cells(.Rows.Count, colID).End(xlUp).Offset(, 2)) _
.FormulaR1C1 = "=VLOOKUP(RC[-1],UniqueID!C[-26],1,FALSE)"
End With
End If
I am new to VBA and have been struggling with finding a solution to copying & pasting some formulas into a range with a variable end row. I managed to cobble together the below code, which works, but it is inefficient because it pastes the formulas one row at a time. I would like to copy the formulas and then paste them into the entire range at once (instead of row by row). I have to do this function in a few different sheets and ranges so ideally I'd like to create a sub routine to find the last row. What I don't know is 1) how to find the last row 2) how to reference it when I'm selecting the range to paste the formulas into.
The sheet is setup with data in the first column, starting in cell C9, and the formulas are in D8:I8. I need to copy the formulas into the range of D9.I? (with the last row being the last row of data in column C).
I've been working on this for about 5 hours and am going out of my mind. Any help would be appreciated!
Sample of the code I have managed to write that works but isn't efficient:
Range("D8").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, -1).Select
Do Until ActiveCell.Value = Empty
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(1, 0).Select
Loop
The classic way to find the last used row is shown below. Call the function like Debug.Print LastRow or, directly in the Immediate Window, with ? LastRow
Function LastRow() As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(XlUp).Row
End with
End Function
Observe that both, the .Rows.Count and the result are taken from the ActiveSheet and that the measure is taken in column "A". (You can replace the name "A" with the number 1 in the above formula). If you want to develop the function, pass both the sheet and the column to it as arguments.
.Cells(.Rows.Count, "A") defines the cell A1400000 (or thereabouts), the last cell in the column. Then the function looks for the first occupied cell above that, meaning that if A1 and A10 are in use and A2:A9 are blank, the function will return 10. It's important to understand that .Cells(.Rows.Count, "A").End(XlUp) is a range object, a cell, of which the .Row property holds the number of the row where that range is located.
Now, if you want to define a range D9:I? you might do it like this, setting the range by defining its first and last cell. Observe the 4 leading periods. Each one stands for the object in the With statement, in this case ActiveSheet.
With ActiveSheet
Set MyRange = .Range(.Cells(9, "D"), .Cells(.Rows.Count, "I").End(xlUp))
End With
But that would take the measure for the last used cell in column I. Often it's the first column on the left that is longer than the last column in the required range. In that case you might use code as shown below.
With ActiveSheet
Set MyRange = .Range(.Cells(9, "D"), .Cells(.Rows.Count, "D").End(xlUp))
End With
With MyRange
Set MyRange = .Resize(.Rows.Count, 9)
End With
The code first sets the range for column D only, presuming that column D is the longest one, and then expands it to include 9 columns. Observe the .RowsCount refers to the ActiveSheet in the first With block and to MyRange in the second.
Of course, you could achieve a similar result with this code which calls the LastRow function (which measures the last row in column A):-
With ActiveSheet
Set MyRange = .Range(.Cells(9, "D"), .Cells(LastRow, "I"))
End With
This solution is a Subroutine to fill a range with values (in this case, formulas) and find the LastRow in a separate Function. There are many ways to do this so feel free to modify it how you please.
First this Subroutine receives the relevant Worksheet, range the formulas are in and the Column letter for the start and end of our destination range.
The Sub uses the Range.AutoFill method to fill the destination range, much the same as if you click the bottom right of a cell with a value and drag up/down/left/right to fill the cells in that direction.
Public Sub AutoFillVariableSizedRangeByRow _
(ByRef TargetWorkSheet As Worksheet, _
ByVal TargetValueCellAddress As String, _
ByVal StartColumn As String, _
ByVal EndColumn As String)
Dim RangeValuesArray As Variant
Dim TargetValueCell As Range
Dim TargetRange As Range
Set TargetValueCell = TargetWorkSheet.Range(TargetValueCellAddress)
Set TargetRange = TargetWorkSheet.Range(StartColumn & Right(Mid(TargetValueCellAddress, 4), 1) & ":" & _
EndColumn & LastRow(TargetWorkSheet, "C"))
TargetValueCell.AutoFill TargetRange
End Sub
The LastRow is found by a separate function, which is well explained already in many places on the net, including another answer to this question.
Public Function LastRow(ByRef TargetSheet As Worksheet, ByVal TargetColumnLetter As String) As Long
LastRow = TargetSheet.Cells(Rows.Count, TargetColumnLetter).End(xlUp).Row
End Function
To write the LastRow function with excel references (not user defined variables), it would look like:
Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
To call the sub it could look something like:
Private Sub myProcedure()
AutoFillVariableSizedRangeByRow ThisWorkbook.Sheets("Sheet1"), "D1:I1", "D", "I"
End Sub
In the above, ThisWorkbook.Sheets("Sheet1") is TargetWorkSheet and "D1:I1" is TargetValueCellAddress, "D" and "I" are the start and end columns of our destination range respectively.
In this example, I've put values 1 to 20 down column C and the formula =$C1*$C1 in row 1 of columns D to I, all on Sheet1.
And here is the output after running AutoFillVariableSizedRangeByRow Sheet1, "D1:I1", "D", "I":
As example, the formula across row 8 is =$C8*$C8 and row 20 is =$C20*$C20.
I tried to use my other similar VBA code but I don't think I understand what I'm trying to replace for the range. In this code, I am trying to copy the data in the Repeating Items sheet in the fourth column with the cell value of 12, then paste it to the last worksheet.
' Repeating items worksheet
Worksheets("Repeating Items").Select
ActiveSheet.ShowAllData
b = Worksheets("Repeating Items").Cells(Rows.Count, 1).End(xlUp).Row
' Filters the data where column 2 equals to 12 to x. ** this is where the error starts
ActiveSheet.Range(Cells(1, 1), Cells(b, 4)).Autofilter Field:=4, Criteria1:="12", Operator:=xlFilterValues
' Selects only the filtered cells and copy
Range(Cells(2, 1), Cells(b, 4)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Select
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Per the Microsoft Documentation, you can just apply the filter to the first row much how you would manually do in excel and it will automatically filter your range. You don't need to quote your number filter FYI (unless the column is Text).
Also, no need to Select anything here. It is just a middle man operator that only slows your code down. Instead, explicitly define your objects (sheets and ranges) and skip right to the action statements (copy/paste).
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Repeating Items")
Dim ls As Worksheet: Set ls = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:D1").AutoFilter Field:=4, Criteria1:=12
ws.Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Copy
ls.Range("A" & ls.Range("A" & ls.Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
End Sub
In column 'M' i have hundreds of rows with multiple duplicates. I only want one record to show per duplicate when i run my macro. Below is my code and it deletes all records apart from one.
Sub DeleteRows()
With ActiveSheet
Set Rng = Range("M5:M").End(xlDown)
Rng.RemoveDuplicates Columns:=1, Header:=xlYes
End With
End Sub
It starts from M5 as this is where the data is initially. Why would it only be showing one record?
Your original attempt, Range("M5").End(xlDown), is just one cell.
Your new attempt, Range("M5:M").End(xlDown), is closer but not a valid Range reference.
Try the following:
Set Rng = Range("M5:M" & Cells(Rows.Count, "M").End(xlUp).Row)
EDIT:
If you're dealing with an entire range, you need to specify the Columns argument of Range.RemoveDuplicates, something like this:
Sub RemoveDupes()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:V" & lastRow).RemoveDuplicates Columns:=Array(13), Header:=xlYes ' column M = 13
End Sub
I'm very new to VBA and was hoping to get come clarification on a project. I've tried solving it with formulas but I need to still be able to enter information into cells and not have them filled with a lookup formula.
How I'm looking for it to preform is that if an object requires it to be shipped then the serial numbers and identifiers are copied and pasted in another table in the next blank row automatically.
Information divided into two tables
What I thought I needed was a segment in VBA that went like this:
Sub CopyCat()
If Range("J2") Like "*yes*" then
Range("G2:I2").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
If Range("J3") Like "*yes*" then
Range("G3:I3").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
End If
End If
End Sub
It does exactly what I ask it to do when it is only the first statement, when I add the second one to check if the next row satisfies the conditions and it does, then it places it in the same resulting cell as the first statement. If both are true I need them both to be displayed in table 1.
I'd love to take this as a learning opportunity so any information or direction you can point me in would be great! Thank you so much in advance!
I think Range("A2:A10").end(xlup) is equivalent to Range("A2").end(xlup) so will not change, but you don't want the A2 reference, you want to work up from the bottom. You will hit problems if you are going beyond A9. (Plus not sure you want nested Ifs.)
If Range("J2") Like "*yes*" Then
Range("G2:I2").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
If Range("J3") Like "*yes*" Then
Range("G3:I3").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Or to add a loop and circumvent the copy/paste you could use something like this:
Sub CopyCat()
Dim r As Long
For r = 2 To Range("J" & Rows.Count).End(xlUp).Row
If Range("J" & r) Like "*yes*" Then
Range("A10").End(xlUp).Offset(1).Resize(, 3).Value = Range("G" & r).Resize(, 3).Value
End If
Next r
End Sub
You can also do this without VBA.
In A2, you can use this formula entered as an array formula with CTRL+SHIFT+ENTER:
=INDEX($G$2:$G$4,SMALL(IF($J$2:$J$4="yes",ROW($J$2:$J$4)-ROW($J$2)+1),ROWS(J$2:J2)))
And in B2, you can put this and drag down/over from B2:D3:
=INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))
Finally, to hide the errors that show when there are no more matches, you can simply wrap both above formulas in IFERROR([formula above],"").
With autofilter
Sub copyRange()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim lastRow As Long
Dim filterRange As Range
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet2") 'change to sheet name containing delivery info
With wsSource
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
Set filterRange = .Range("G1:K" & lastRow)
Dim copyRange As Range
Set copyRange = .Range("G2:K" & lastRow)
End With
Dim lastRowTarget As Long, nextTargetRow As Long
With filterRange
.AutoFilter
.AutoFilter Field:=4, Criteria1:="yes" 'change field to whichever is the field in the range containing your company names
lastRowTarget = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
nextRowTarget = lastRowTarget + 1
Union(wsSource.Range("G2:I" & lastRow).SpecialCells(xlCellTypeVisible), wsSource.Range("K2:K" & lastRow).SpecialCells(xlCellTypeVisible)).Copy wsSource.Range("A" & nextRowTarget)
.AutoFilter
End With
End Sub