I have the following VBA code:
Sub sort()
Range("M2:M").Sort _
Key1:=Range("M2"), Order1:=xlAscending
End Sub
But, it's not working. How do I fix it?
It's not working because you are using a google-sheets syntax on the column; excel wants a last row specified. The Sort also want the primary key to be the first cell in the "M2:M" & lr range. Telling it M2, relative to Range("M2:M" & lr) is actually referencing Y3. You should know if you are using a header or not; I'm assuming any header label is in M1 so for Range("M2:M" & lr) you use Header:=xlNo.
Sub msort()
dim lr as long
lr = cells(rows.count, "M").end(xlup).row
with Range("M2:M" & lr)
.Sort Key1:=.cells(1), Order1:=xldescending, _
Orientation:=xlTopToBottom, Header:=xlNo
end with
End Sub
You should also avoid reserved words for the names of your sub procedures and variables. Get into the habit of providing parent worksheet references.
btw, dates ordered newest to oldest are in an xldescending order, not xlascending.
Related
I've been working on a code to sort a block of data using Range.Sort using a custom sort order. I've tried to record macros and look online but came up more confused about this problem.
For the key1:= argument; is it a single cell (e.g. Range("A1")) or a whole column?
How exactly can I use a custom sort order in OrderCustom:=?
In the case I'm going about this all wrong; the Range in Range.Sort can be anywhere as long as its in one continuous block, correct?
Here is the code I'm working with:
Sub Test()
Dim quantity As Variant
quantity = 2 + WorkshetFunction.Count(Range("A" & 3, "K" & 900))
With Range("A" & 3, "K" & quantity)
.Sort key1:=Range("A" & 3)
Order:=xlAscending
Header:=xlNo
OrderCustom:="VALID, GOOD, DUE, OVERDUE, WAY OVERDUE, MISSING"
'> This is the order in which I want the items on this list sorted by.
End With
End Sub
The Range("A" & 3, "K" & quantity) refers to a block of data containing on "A" the "status" of some items determined by their calibration expiration dates, amongst other data which is irrelevant for this purpose, and I'm not in the liberty to share. All I'm asking is help understanding the inner workings of the .Sort method. Thanks!
Give'r
Sub SortItOut()
Dim rng As Range, sh As Worksheet
Set sh = Sheets("Sheet1")
With sh
Set rng = .Range("A3:K" & .Cells(.Rows.Count, "K").End(xlUp).Row)
With rng
sh.Sort.SortFields.Clear
sh.Sort.SortFields.Add Key:=Range("A3") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"VALID,GOOD,DUE,OVERDUE,WAY OVERDUE,MISSING", DataOption:=xlSortNormal
End With
With .Sort
.SetRange rng
.Orientation = xlTopToBottom
.Apply
End With
End With
End Sub
First, my code (below) works, but I am trying to see if it can be simplified. The macro in which this code is located will have a lot of specific search items and I want to make it as efficient as possible.
It is searching for records with a specific category (in this case "Chemistry") then copying those records into another workbook. I feel like using Activate in the search, and using Select when moving to the next cell are taking too much time and resources, but I don't know how to code it to where it doesn't have to do that.
Here are the specifics:
Search column T for "Chemistry"
Once it finds "Chemistry", set that row as the "top" record. e.g. A65
Move to the next row down, and if that cell contains "Chemistry", move to the next row (the cells that contain "Chemistry" will all be together"
Keep going until it doesn't find "Chemistry", then move up one row
Set that row for the "bottom" record. e.g. AX128
Combine the top and bottom rows to get the range to select. e.g. A65:AX128
Copy that range and paste it into another workbook
Here is the code:
'find "Chemistry"
Range("T1").Select
Cells.Find(What:="Chemistry", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'set top row for selection
toprow = ActiveCell.Row
topcellselect = "A" & toprow
'find all rows for Chemistry
Do While ActiveCell = "Chemistry"
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
'set bottom row for selection
bottomrow = ActiveCell.Row
bottomcellselect = "AX" & bottomrow
'define selection range from top and bottom rows
selectionrange = topcellselect & ":" & bottomcellselect
'copy selection range
Range(selectionrange).Copy
'paste into appropriate sheet
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial
Thanks in advance for any help!
You never need to select or activate unless that's really what you want to do (at the end of the code, if you want the user to see a certain range selected). To remove them, just take out the activations and selections, and put the things on the same line. Example:
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial
Becomes
wb1.Sheets("Chemistry").Range("A2").PasteSpecial
For the whole code; I just loop thorugh the column and see where it starts and stops being "chemistry". I put it in a Sub so you only have to call the sub, saying which word you're looking for and where to Paste it.
Sub tester
Call Paster("Chemistry", "A2")
End sub
Sub Paster(searchWord as string, rngPaste as string)
Dim i as integer
Dim startRange as integer , endRange as integer
Dim rng as Range
With wb1.Sheets("Chemistry")
For i = 1 to .Cells(Rows.Count,20).End(XlUp).Row
If .Range("T" & i ) = searchWord then 'Here it notes the row where we first find the search word
startRange = i
Do until .Range("T" & i ) <> searchWord
i = i + 1 'Here it notes the first time it stops being that search word
Loop
endRange = i - 1 'Backtracking by 1 because it does it once too many times
Exit for
End if
Next
'Your range goes from startRange to endRange now
set rng = .Range("T" & startRange & ":T" & endRange)
rng.Copy
.Range(rngPaste).PasteSpecial 'Paste it to the address you gave as a String
End with
End sub
As you can see I put the long worksheet reference in a With to shorten it. If you have any questions or if it doesn't work, write it in comments (I haven't tested)
The most efficient way is to create a Temporary Custom Sort Order and apply it to your table.
Sub MoveSearchWordToTop(KeyWord As String)
Dim DestinationWorkSheet As Workbook
Dim SortKey As Range, rList As Range
Set SortKey = Range("T1")
Set rList = SortKey.CurrentRegion
Application.AddCustomList Array(KeyWord)
rList.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Application.DeleteCustomList Application.CustomListCount
Set DestinationWorkSheet = Workbooks("Some Other Workbook.xlsx").Worksheets("Sheet1")
rList.Copy DestinationWorkSheet.Range("A1")
End Sub
I want to creat a macro that matches against a whitelist, then delete everything that's not on the whitelist. I have the following code:
Sub WHITELIST()
Dim LR As Long, i As Long
With Sheets("Sheet1")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
If IsError(Application.Match(.Range("A" & i).Value, Sheets("Whitelist").Columns("A"), 0)) Then .Rows(i).Delete
Next i
End With
End Sub
But my code deletes the entire row. I only want to delete the range A:B and shift the cells up (the row size is variable so i always want to check till the last row - up to 40.000 rows). Its important that "important Data" doesn't gets deleted too. Here is an example how the macro SHOULD work:
Hope someone can help me
Greetings
Try changing this line
If IsError(Application.Match(.Range("A" & i).Value, Sheets("Whitelist").Columns("A"), 0)) _
Then .Rows(i).Delete
to this
If IsError(Application.Match(.Range("A" & i).Value, Sheets("Whitelist").Columns("A"), 0)) _
Then .Range("A" & i & ":B" & i).Delete Shift:=xlUp
This will only delete the cells in columns A and B.
Using the Shift:=xlUp will allow you delete those specific cells in the range you define and move the entire block of cells below that range up.
I am not a programmer but have managed to cobble together great amounts of code that work on 4 pretty large projects (Yay for me!) I have tried numerous ways to find the Last Row. Some work for me some don't. I can find a few that give me the "actual" last row regardless of blanks in Column A (this is what I need). Yet I CANNOT for my life figure how to integrate that code with the way I am passing values from my array from one workbook to another. All of the code works "As Is" but I need to find a better way of searching the whole row (currently columns A:O) for the Last Row and then copying the data over. Column A maybe empty at times and to avoid the code from being overwritten, that "Last Row" needs to check the whole row. I am currently forcing a hidden cell (A7) with a "." as a forced placeholder. Any advice would be awesome.
Option Explicit
Public Sub SaveToLog15()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long
Dim LastRow As Long
Dim NextCell As Range
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveSheet
Application.ScreenUpdating = False
With Sheet2
' rng are the cells you want to read into the array.
' Cell A7 (".") is a needed "Forced Place Holder" for last row _
determination
' A7 will go away once "better" LastRow can be added to this code
Set rng = Worksheets("Main").Range("A7,D22,D19,D20,J22:J24,E23,D21,J25:J27,D62,D63,G51")
' counts number of cells in MyAr
n = rng.Cells.Count
' Redimensions array for above range
ReDim MyAr(1 To n)
' Sets start cell at 1 or "A"
n = 1
' Loops through cells to add data to the array
For Each aCell In rng.Cells
MyAr(n) = aCell.Value
n = n + 1
Next aCell
End With
On Error Resume Next
' Opens "Test Log.xls"
Workbooks.Open FileName:= _
"S:\Test Folder\Test Log.xls"
' SUBROUTINE 1 "Disable Sheet Protection and Show All" REMOVED
' Finds last row on Tab "Tracking" based on Column "A"
' Last row determination DOES NOT go to next row if first _
Column is blank
' Use A7 "." to always force Data to Col A
'**********************************************************************
'THIS WORKS FINE BUT DOES NOT RECOGNIZE THE POSSIBLE BLANK IN COL A.
With Worksheets("Incoming Data")
Set NextCell = Worksheets("Incoming Data").Cells _
(Worksheets("Incoming Data").Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
' I need this code replaced by the following code or integrated into
' this code snippet. I am lost on how to make that happen.
'***********************************************************************
'***********************************************************************
'THIS CODE FINDS THE "ACTUAL" LAST ROW AND THIS IS WHAT I'D LIKE TO USE
' I need to figure how to integrate this code block with the above
' Or maybe redo the whole thing.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
' I am not using this code in the program. It's just there to show
' what I need to use because it works. I need to make this code work
'WITH the above block.
'***********************************************************************
' Sets the size of the new array and copies MyAr to it
NextCell.Resize(1, UBound(MyAr)).Value = (MyAr)
' SUBROUTINE 2 "Add borders to cells in range" REMOVED
' SUBROUTINE 3 "Re-enable Sheet Protection" REMOVED
ActiveWorkbook.Save
'ActiveWindow.Close
Application.ScreenUpdating = True
MsgBox "Your Data has been saved to the Log File: " & vbCrLf & vbCrLf _
& "'Test Log.xls'", vbInformation, "Log Save Confirmation"
End Sub
This is a common problem with "jagged" data like:
Clearly here column B has that last row. Here is one way to get that overall Last row by looping over the four candidate columns:
Sub RealLast()
Dim m As Long
m = 0
For i = 1 To 4
candidate = Cells(Rows.Count, i).End(xlUp).Row
If candidate > m Then m = candidate
Next i
MsgBox m
End Sub
:
Find works best for most situations, below is the function i use that takes sheet ref as input and returns row number as type Long
Dim lLastRow As Long
lLastRow = LastUsedRow(shName)
Private Function LastUsedRow(sh As Worksheet) As Long
LastUsedRow = sh.Cells.Find(What:="*", After:=sh.Cells.Cells(1), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
End Function
The simplest thing might be to use the specialcells method, as in range.specialcells(xllastcell). This returns the cell whose row number is the last row used anywhere in the spreadsheet, and whose column is the last column used anywhere in the worksheet. (I don't think it matters what "range" you specify; the result is always the last cell on the worksheet.)
So if you have data in cells B30 and X5 and nowhere else, cells.specialcells(xllastcell) will point to cell X30 (and range("A1").specialcells(xlastcell) will also point to cell X30).
Instead of:
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
use this:
LastRow = cells.specialcells(xllastcell).row
MsgBox ("The Last Row Is: " & LastRow)
After 35 attempts this is the code that I was able to hack into my original:
' Used to determine LastRow, LastColumn, LastCell, NextCell
Dim LastRow As Long
Dim LastColumn As Integer
Dim LastCell As Range, NextCell As Range
With Worksheets("Tracking")
' Find LastRow. Works Best. 1st and last cells can be empty
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox "Last Cell" & vbCrLf & vbCrLf & Cells(LastRow, LastColumn).Address
'MsgBox "The Last Row is: " & vbCrLf & vbCrLf & LastRow
'MsgBox "The Last Column is: " & vbCrLf & vbCrLf & LastColumn
End If
' Number of columns based on actual size of log range NOT MyAr(n)
Set NextCell = Worksheets("Tracking").Cells(LastRow + 1, (LastColumn - 10))
End With
This finds the "Real" Last Row and column and ignores any empty cells in Column A or J which seem to affect some of the LastRow snippets. I needed to make it ROWS instead of ROW and HAD the add the Offset portion as well. (-10) puts me back to Column "A" for my sheet and now I have removed Column "A" {the forced Place Holder "."} and have "Real" data there now. YAY for the "Hacking Code Cobbler".
Glad they pay me at work to learn this stuff. :) Solved this a while back. Just now got to update this post.
In Excel, I have a column of names in the format "FirstName LastName". I'd like to split that entire column into two columns, with one containing all of the first names and the other containing all of the last names.
My code so far:
'Splitting the Traveler Display Name column
Dim SplitPoint As Long
'L2 is the column containing names to be split
Range("L2").Select
Do Until IsEmpty(ActiveCell)
'Search for position of space within the cell
SplitPoint = InStrRev(ActiveCell, " ", -1, vbTextCompare)
'Put the last name in the column next to the source column
ActiveCell.Offset(0, 1) = Trim(Left(ActiveCell, SplitPoint))
'Replace the source column with the first name
ActiveCell.Offset(0, 0) = Trim(Mid(ActiveCell, SplitPoint))
Loop
The solutions I have found so far have required that the cells be selected manually, which was unreasonable for the amount of data I am working with. I found this solution, but I get the following error: Invalid Procedure call or argument.
NON VBA Method
Why not use Data~~>Text To Columns?
VBA Method
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim tmpArray() As String
'~~> This is the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
LastRow = .Range("L" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If InStr(1, .Range("L" & i).Value, " ") Then
tmpArray = Split(.Range("L" & i).Value, " ")
.Range("M" & i).Value = tmpArray(0)
.Range("N" & i).Value = tmpArray(1)
End If
Next i
End With
End Sub
Private Sub Sample()
Dim myRng As Range
Dim LastRow As Long
LastRow = Sheets("Sample1").UsedRange.Rows.Count
With Sheets("Sample1")
Set myRng = Sheets("Sample1").Range("A2:A" & LastRow)
End With
myRng.TextToColumns _
Destination:=Range("B2:C2"), _
DataType:=xlDelimited, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False
End Sub
I know that this question is quite old, but sharing an answer for anyone who might encounter the same issue in the future.
I have stumbled across this question as I am searching for answers on how to split a column. I tried the looping method but it takes a long time to process.
I have tried the literal translation of the Text to Columns to VBA. The processing time is almost instant, as it is the same as clicking the TextToColumns.
In my solution above, I set the column A with data (i.e., FirstName & LastName) for splitting as a Range. In the Destination, I placed the Range where I want the splitted data to appear (i.e., Column B for First Name, Column C for Last Name). The delimiter is a space.
It is working fine for me. So far, I have tested the code in a 2000 rows data.
I am quite new to VBA so apologies if the code might be poorly formatted or written.