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
Related
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
============================================================
During counting blank cells I have an issue due to xlUp.That formula range is working only the cell till that there is a value.For instance let assume that
my range is K9:K208 and I have a 155 blank cells. But if there is any value on K205 than it is count as 152 even if has to be 155.How can I handle this issue?
Sub RoundedRectangle2_Click()
Dim lLastRow As Long
lLastRow = Cells(Rows.Count, 11).End(xlUp).Row
Range("A4") = WorksheetFunction.CountIf(Range("K9:K" & lLastRow), "")
End Sub
xlUp is for determining first non-blank cell upwards from starting cell, so Cells(Rows.Count, 11).End(xlUp) will start looking from last row in column K upwards. In your case that will be K208 - that is how you should determine last row (Cells(Rows.Count, 11).End(xlUp).Row).
Having lastRow=208 you can loop starting from 9th row in K column (K9), like
For i = 9 To lastRow and count all blank cells - this will guarantee that you won't miss anything :)
Here's code to get you started:
Sub CountBlanks()
Dim i, lastRow As Long
lastRow = Cells(Rows.Count, 11).End(xlUp).Row
For i = 9 To lastRow
'check if cell is blank and do any other operations
Next
End Sub
Here is an alternate method of locating a 'last row' across many columns.
dim lastRow as long
with worksheets("sheet1")
lastRow = .cells.find("*", after:=.cells(1), _
searchorder:=xlbyrows, searchdirection:=xlprevious).row
.Range("A4") = WorksheetFunction.CountIf(.Range("K9:K" & lastRow), "")
end with
I have two columns.. "AE" and "AG"
The headers are in row 4 of the worksheet and all the data starts from row 5 onwards.
I just want to copy the whole column of "AG" starting from "AG5" until the first blank row and paste it AS values into "AE" in the exact same range (starting from "AE5"). How can I go about doing that?
Try below.
With ActiveSheet
LR = .Range("AG1048576").End(xlUp).Row
.Range("AG5:AG" & LR).Copy
.Range("AE5").PasteSpecial xlValues
End With
You may need to change Activesheet to
sheets("NAME OF SHEET")
Value transfer is faster than a copy and paste.
dim lr as long
with worksheets("sheet1")
lr = .cells(.rows.count, "AG").end(xlup).row
.range(.cells(5, "AE"), .cells(lr, "AE")) = .range(.cells(5, "AG"), .cells(lr, "AG")).value
end with
This question already has answers here:
How to Split a single cell into multiple rows and add another row
(3 answers)
Closed 5 years ago.
I have excel sheet with two columns, the first column contains contain names and second contain multiple semicolons separated values I want to separate the second column and transpose with first column value repeated,
example
sheet:
testa KRAS;EGFR
second HSP90AB1;KSR1;PLXND1;LAMB2;ROCK2
test PPP2R1A;TRIB3;EGFR;FGFR2
Result:
testa KRAS
testa EGFR
second HSP90AB1
second KSR1
second PLXND1
second LAMB2
second ROCK2
test PPP2R1A
test TRIB3
test EGFR
test FGFR2
Right now I am manually separating it, is there any macros/VBA for this?
I happen to have a macro that pretty much does this, so I just tweaked it to match your data. Otherwise, I'd also ask that you show some effort first. I assume your data is in column A ("testa", "second", etc) and column B (the delimited data)
Sub splitCopyDown()
Dim rng As Range, cel As Range
Dim cols As Long, lastRow As Long, i As Long, k As Long
Set rng = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
rng.TextToColumns Destination:=Range("B1"), Semicolon:=True
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = lastRow To 1 Step -1
cols = Cells(i, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(i, 3), Cells(i, cols))
Range(rng.Offset(1, 0), rng.Offset(cols - 2, 0)).EntireRow.Insert
rng.Copy
rng.Cells(1).Offset(1, -1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
rng.Clear
Next i
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range(Cells(1, 1), Cells(lastRow, 1)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
Range(Cells(1, 1), Cells(lastRow, 1)).Value = Range(Cells(1, 1), Cells(lastRow, 1)).Value
End Sub
(It's an older macro, but it checks out. You could likely make it more efficient)
While BruceWayne beat me to the punch, I quickly jotted this subroutine out so I figured I should share it so I don't feel like I wasted 5 minutes of my day.
Sub liftAndSeperate()
Dim rngData As Range
Dim intWriteRow As Integer
Dim rngReadRow As Range
Dim readArrayElem As Variant
'Assuming the data is in Sheet1 A1:B20
Set rngData = Sheet1.Range("A1:B20")
'Assuming we will write to Sheet2 starting at row 1:
intWriteRow = 1
'Loop through each row in that range:
'The row we are reading will be held in variable rngReadRow
For Each rngReadRow In rngData.Rows
'Generate an array using split and loop through the array to write the values out
For Each readArrayElem In Split(rngReadRow.Cells(1, 2).Value, ";")
'Write out column A from sheet1 to sheet2
Sheet2.Cells(intWriteRow, 1).Value = rngReadRow.Cells(1, 1)
'Write out the array element
Sheet2.Cells(intWriteRow, 2).Value = readArrayElem
'Increment to the next write row
intWriteRow = intWriteRow + 1
Next readArrayElem
Next rngReadRow
End Sub
p.s. BruceWayne is Batman (now his cover is blown)
I'm at a loss on this and need some help. I've lurked around at answers and have Frankensteined together some code for a macro but it just isn't working.
Here is part of what I have so far:
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
With .Cells(lrow, "G")
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
Next lrow
End With
I have a very similar block of code before this that deletes crap from the text files I'm importing and it works perfectly through all the number of rows. When I run the same thing with this formula, it only puts the formula in G1 and doesn't cycle through the rest of the sheet. I've tried this and it works, but copies down through all million plus rows:
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Selection.AutoFill Destination:=Range("G:G")
I've tried this and then run the same code that gets rid of the text file crap but I get an error "End If without block If".
To fill the formula in one cell at a time you need to cycle through them; don't keep relying on the ActiveCell property.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
.Cells(lrow, "G").FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Next lrow
End With
But you can speed things up by putting the formula into all of the cells at once.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range(.Cells(Firstrow, "G"), .Cells(Lastrow, "G"))
.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
End With
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Another version, to dynamically select the columns based on their titles. Comments included.
Dim row As Range
Dim cell As Range
Static value As Integer
'Set row numbers
'Find the starting row. Located using Title of column "Start" plus whatever number of rows.
Dim RowStart As Long
Set FindRow = Range("A:A").Find(What:="Start", LookIn:=xlValues)
RowStart = FindRow.row + 1
'End of the range. Located using a "finished" cell
Dim RowFinish As Long
Set FindRow = Range("A:A").Find(What:="Finished", LookIn:=xlValues)
RowFinish = FindRow.row - 1
'Set range - Goes Cells(Rownumber, Columnnumber)
'Simply ammend RowStart and RowFinish to change which rows you want.
' In your case you need to change the second column number to paste in horizontally.
Set rng = Range(Cells(RowStart, 1), Cells(RowFinish, 1))
'Start the counter from the starting row.
value = RowStart
For Each row In rng.Rows
For Each cell In row.Cells
'Insert relevant formula into each cell in range.
cell.Formula = _
"=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
'Increment row variable.
value = value + 1
Next cell
Next row