I have 8 Columns with Data and there are multiple duplicates in Column 1 and other columns have values and texts.
I want to keep the Column 5 highest values and remove duplicates from Column 1.
Your help will be appreciated.
Sub KeepHighvalue()
Dim MyRange As Range
Dim LastRow As Long
Dim Sht1 As worksheet
Set Sht1 = Worksheets("Sheet1")
LastRow = Sht1 .Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = Sht1 .Range("A1:A" & LastRow)
MyRange.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
usaupload.com/5g09/Data.xlsx
Assuming it's ok to sort the data (and assuming I've correctly interpreted what you mean by keeping the highest values), the following is one way to approach the problem. It will remove rows (in the defined 8 columns of data, starting at A1), where data is duplicated in column A, keeping rows with the highest value in column E (5).
Sub KeepHighvalue()
Dim lgLastRow&, rgData As Range
''' Set target data area (rgData)
With Worksheets("Sheet1")
lgLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rgData = .Range("A1:H" & lgLastRow)
End With
''' Remove rows with duplicates in column 1, keeping rows with highest values in column 5
With rgData
.Sort Key1:=.Columns(5), Order1:=xlDescending, Header:=xlYes
.RemoveDuplicates Columns:=1, Header:=xlYes
End With
End Sub
If sorting isn't ok, the solution is a little more complex.
============================================================
EDIT: Sample Before and After
============================================================
Related
I've been struggling with this problem for a whole month...
Here is the point. I've got a sheet in excel called Amounts where there are many datas listed under 10 columns from cell A2 to cell J2. The last colum can vary day to day. There are headnames above those different datas that allows me to know the type of data.
Anyway, there are many columns where the header start with the following value Amount of (date). I want to make a code that;
Allows me to search automatically for all the columns'name that starts with the value Amount of
Copy all of the data below (from the first data until the last one). The range of datas under each column can vary from day to day.
And finally paste each of the range data copied under the column header on other sheet and in one single column (starting in cel(1,1)).
Here's how my current code looks like;
Dim cel As Range
With Sheets("Amounts")
Worksheets("Amounts").Activate
For Each cel In Range("A2", Range("A2").End(xlToRight)
If cel.Value Like "Amount in USD *" Then
cel.Offset(1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Worksheets("Pasted Amounts").Range("A2")
End If
Next cel
Could you please help me with this...? I feel like the answer is so obvious like the nose in the middle of my face.
Try this. I have commented the code so you should not have a problem understanding it.
Option Explicit
Sub Sample()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String
'~~> Set your sheets here
Set wsInput = Sheets("Amounts")
Set wsOutput = Sheets("Pasted Amounts")
With wsInput
'~~> Find last column in Row 2
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'~~> Loop through columns
For i = 1 To lCol
'~~> Check for your criteria
If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
'~~> Get column name
Col = Split(.Cells(, i).Address, "$")(1)
'~~> Get the last row in that column
lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
'~~> Find the next row to write to
If lRowOutput = 0 Then
lRowOutput = 2
Else
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
End If
'~~> Copy the data
.Range(Col & "3:" & Col & lRowInput).Copy _
wsOutput.Range("A" & lRowOutput)
End If
Next i
End With
End Sub
Worth a read
How to avoid using Select in Excel VBA
Find Last Row in Excel
Pretty much what I listed in the subject line with the exception this needs to only add data to column P if there is data in adjacent rows.
For example if there are 20 rows of data I only need this to copy P1 through P20. But the rows will fluctuate, sometimes there may be 50 rows, sometimes there may be 5 etc....
Sub DaysToPay()
'DaysToPay Macro
Range("P2").Select
ActiveCell.FormulaR1C1 = "=RC[-5]+10"
Range("P3").Select
'...
End Sub
Sub Free()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long 'last row
lr = ws.Range("P" & ws.Rows.Count).End(xlUp).Row
ws.Range("P1:P" & lr).Copy '<-- Copy
ws.Range("?").PasteSpecial xlPasteValues '<-- Paste where?
End Sub
I'm looking to create a macro that will display the Sum from a set column of each of multiple sheets. I need the total of column "K" to be shown 1 row from the last entry of a variable number of entries. It is a requirment that this is in VBA as it needs to run with a number of other functions.
I've tried the below code but it does not give the expected result and seems to be drawing data from other sheets.
Sub SumWorksheets()
Dim LastRow As Long
Dim ws As Worksheet
For Each ws In Worksheets
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("K" & LastRow + 1) = Application.WorksheetFunction.Sum(Range("K2:K" & ws.Rows.Count))
Next
End Sub
I want the Total of all numbers in Column "K" to display 2 rows below the last number in Row "K"
Declared and fully use ws and LastRow variables. Not using can cause code to pull values from another worksheet. Per comment from #LoveCoding, using a different column as the LastRow can overwrite a cell in Col K. You should have used the LastRow variable, in the Sum function.
Dim ws As Worksheet, LastRow As Long
For Each ws In ThisWorkbook.Worksheets
LastRow = ws.Range("K" & ws.Rows.Count).End(xlUp).Row
ws.Range("K" & LastRow + 1) = Application.WorksheetFunction.Sum(ws.Range("K2:K" & LastRow))
Next
I have fund names in columns of one sheet("All") and weekly fund returns in the corresponding columns of other sheet("EDITED"). I defined fund names and returns as ranges and tried to sort names using returns as key in VBA. My objective is to sort every column since each column represents another week. My code is down below. Thanks in advance.
Sub Sortmydata()
Dim rng As Range
Dim keyrng As Range
For i = 5 To 385
Set rng = Worksheets("All").Range(Cells(3, i), Cells(385, i))
Set keyrng = Worksheets("EDITED").Range(Cells(3, i), Cells(385, i))
rng.Select
Selection.Sort key1:=keyrng, _
order1:=xlAscending, Header:=xlNo
i = i + 1
Next i
End Sub
Remove i = i + 1 from your code, the for loop increments automatically.
With the i = i + 1 your skip a column.
Hi I figured sorting can only be made in same range with key values.
So I created a pseudo range with the values I want to sort and my key values.
Sorted in the pseudo range and copy-paste into range where I wanted to.
Thanks,
Sub Sort2()
Dim ws As Worksheet
Dim keyrange As Range
Dim sortrange As Range
For i = 5 To 254
Worksheets("Tier2").Activate
Set sortrange = Range(Cells(3, i), Cells(45, i))
sortrange.Copy
Range("IW3").PasteSpecial xlPasteValues
Worksheets("EDITEDTier2").Activate
Set keyrange = Range(Cells(3, i), Cells(45, i))
keyrange.Copy
Worksheets("Tier2").Activate
Range("IX3").PasteSpecial xlPasteValues
Range("IW3:IX45").Sort Key1:=Range("IX3:IX45"), _
order1:=xlDescending, Header:=xlNo
Range("IW3:IW45").Copy
sortrange.PasteSpecial xlPasteValues
Next i
End Sub
I am trying to sort a range of cells without hardcoding the starting and stopping points. My range will always start in column A and span to column M, however the rows it stops and starts on will vary. I figured out how to set a variable and incorporate it into the Range function for the last-row, but I can't figure out how to do that for the row the range should start on. Here is my code so far:
Range("A6:M" & lastRow).Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlNo
This works only if I start my range on row 6. What I can't figure out is how to tell excel to start my range on the first row that is not blank in column A.
Thanks!
Determine if A1 is blank. Use A1 if not blank and the [ctrl]+[down] if it is blank.
dim startRow as long, lastRow as long
With worksheets("sheet1")
lastRow = .cells(.rows.count, "M").end(xlup).row
if isempty(.cells(1, "A") then
startrow = .cells(1, "A").end(xldown).row
else
startRow = 1
end if
with .range(.cells(startrow, "A"), .cells(lastrow, "M"))
.cells.Sort Key1:=.cells(1), Order1:=xlAscending, Header:=xlNo
end with
end with