Sorry about the flury of posting, I am trying to finish a project (there always seems to be one more thing)
I am tring to auto sort to last column starting at F2 I have the following but is not working
Thanks
Sub Sort()
Dim lastRow As Long
Dim lastCol As Long
Dim ws As Worksheet
Set ws = Sheets("sheet1")
lastRow = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
lastCol = Cells(2, ws.Columns.Count).End(xlToLeft).Column
With Sheets("Sheet1")
ws.Range(ws.Range("F2"), ws.Cells(lastRow, lastCol)).Sort _
Key1:=Range("lastCol"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub
The value for Key1 must be a range. You are trying to use the number that is the last column, and that won't work even if you remove the quotation marks.
Replace Key1:=Range("lastCol")
with Key1:=Cells(2, lastCol)
Note that you can use the GetColumnLetter function I included in my previous answer to get the letter for the lastCol column. If you have the letter, you can use this syntax instead of the Cells version:
Key1:=Range(myCol & 2)
To make sure you know what you are sorting, you can add a little bit of debugging code. You can also use the Immediate window and the Watch window to figure this out.
Replace your entire sub with this:
Sub Sort()
Dim lastRow As Long
Dim lastCol As Long
Dim ws As Worksheet
Dim rng As Range
Dim sortRng As Range
Set ws = Sheets("sheet1")
lastRow = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
lastCol = Cells(2, ws.Columns.Count).End(xlToLeft).Column
Set rng = ws.Range(ws.Range("F2"), ws.Cells(lastRow, lastCol))
Set sortRng = ws.Cells(lastRow, lastCol)
MsgBox "I will sort this range: " & rng.Address & _
" using this column: " & sortRng
rng.Sort Key1:=sortRng, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Related
I am looking for some help modifying existing code in a worksheet that I had created a while back to copy and paste a range from a row rather than the entire row itself.
The original code, which has worked perfect in the original intended function, it would search column A in the Data worksheet for a specified match. it would then copy that row into a specified worksheet and paste each match as a new row.
What I have been trying to modify the code to do now is perform that same search of column A for either " New, Existing Being Removed, Existing To Remain". When finding one of the 3 options it would then copy the data from columns b:g of that matching row and paste it into the rent worksheet starting at a specified cell. For instance rows marked as Existing to remain would need to star being pasted at cell B3, Existing being removed cell m3, and New cell x3. In total there would not be more than 20 rows from the data sheet that would need to be copied and pasted appropriately.
The code below is the current working code that will search, copy, and paste the entire matching row. Not being extremely proficient with VBA code I didn't want to post the muddled mess that I had made of the original code.
Edit With Photos*
#Toddleson I made the changes you suggested but ended up getting an error with the copyfrom.copy line. It is probably much easier to see what I am trying to accomplish visually. In the Data sheet image link below you will see that row A is where the search occurs. For each match it will copy the values from columns B:G of that row and then paste that into the rent sheet.
If you take a look at the rent image you will see that it is broken into the 3 cooresponding sections. From the match that was found in the cooresponing deisgnation from column A in the data sheet it will then paste the information from columns B:G in the Data to the B:G columns in the Rent sheet.
Data Sheet
Rent
Private Sub CommandButton4_Click()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
Dim strSearch As String
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Data")
strSearch = "New"
With ws1
.AutoFilterMode = False
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Resize(lRow - 1, 7)
End With
.AutoFilterMode = False
End With
Set ws2 = wb1.Worksheets("Rent")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=Range("p3"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
copyFrom.Copy ws2.Cells(3, 16).Resize(copyFrom.Rows.Count, copyFrom.Columns.Count)
End With
strSearch = "Existing Being Removed"
With ws1
.AutoFilterMode = False
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
.AutoFilterMode = False
End With
Set ws2 = wb1.Worksheets("Rent")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=Range("p19"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
copyFrom.Copy ws2.Cells(3, 16).Resize(copyFrom.Rows.Count, copyFrom.Columns.Count)
End With
strSearch = "Existing To Remain"
With ws1
.AutoFilterMode = False
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
.AutoFilterMode = False
End With
Set ws2 = wb1.Worksheets("Existing To Remain")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("p35"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
copyFrom.Copy ws2.Cells(3, 16).Resize(copyFrom.Rows.Count, copyFrom.Columns.Count)
End With
End Sub
I have two tables placed in many sheets. I go through the sheets copying the data from one of the two tables. The range can vary, so it is not something I can statically code the range.
Each table ends in "Total" so that was the string I was attempting to find in the column and setting the last row equal to "Total's" row.
How do I copy the range of my second table (green background). These tables will not be the same range for each sheet.
I have set it up so the 'addSetB' which copies the first table (blue background) by copying the range and ending at "Total". So for 'addSetC' I tried setting it up so it will begin copying after the first total and stop at the second table, grabbing the range of the second table.
Is there a better way to accomplish this? Or how should I go about fixing my current code?
I get
runtime error 91: "Object variable or With block variable not set".
Highlighting the 'startRow' line.
Updated Sub addSetC() code. Now throwing:
Runtime-error: 1004 "Application-defined or object-defined error"
for ActiveSheet.Range("L" & startRow & ":Q" & lastRow).Copy after implementing BigBen's suggestion.
Table layout
' Copy range of the green background (not working / throwing errors)
Sub addSetC()
Dim lastL As Long
lastL = ActiveSheet.Range("L" & rows.Count).End(xlUp).row
Dim FoundRow As Range
Dim startRow As Integer
Dim lastRow As Integer
Dim rng As Range
With ActiveSheet.Range("L2:L" & lastL)
'Set startRow to first "Total"
Set rng = .Find(What:="Total", LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rng Is Nothing Then startRow = rng.row
'Set lastRow to second "Total"
Set rng = .Find(What:="Total", _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not rng Is Nothing Then lastRow = rng.row
ActiveSheet.Range("L" & startRow & ":Q" & lastRow).Copy
End With
Sheets("DATA").Activate
Cells(Range("A" & rows.Count).End(xlUp).row + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
The above code is not copying the second table.
Here's what I used to copy the first table (blue background) which is working. How do implement this in my other subroutine to copy the other table?
' Copy range of blue background (functioning properly)
Sub addSetB()
Dim lastRow As Integer
lastRow = Cells.Find(What:="Total", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Range("L3:Q" & lastRow).Copy
Sheets("DATA").Activate
Cells(Range("A" & rows.Count).End(xlUp).row + 1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
I need to copy the last line of data, copy it with formulas to the row below it and then do a find and replace on the new last row - I got it to copy the line down but the find and replace isnt working - any tips? Thanks.
Sub CopyLastRowandReplace()
Dim sourceSheet As Worksheet
Dim sourceRange As Range
Dim LastRow As Long
Dim ReplaceRow As Range
Set sourceSheet = ThisWorkbook.Worksheets("Book 1")
LastRow = sourceSheet.Range("B" & sourceSheet.Rows.Count).End(xlUp).Row
Set sourceRange = sourceSheet.Range("B" & LastRow & ":N" & LastRow)
sourceRange.Offset(1).Formula = sourceRange.Formula
Set ReplaceRow = sourceSheet.Range("B" & LastRow & ":N" & LastRow)
Range("B" & LastRow & ":N" & LastRow).Select
Selection.Replace What:="Aug", Replacement:="Sep", LookAt:=xlFormulas, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Core problems
LookAt:=xlFormulas. Sould be xlPart or xlWhole
You are not Replacing in the New last row (you haven't updated LastRow)
That said, there are other oportunities for improvement too
Sub Demo()
CopyLastRowandReplace ThisWorkbook.Worksheets("Book 1"), 2, 13, "Aug", "Sep"
End Sub
Sub CopyLastRowandReplace(sourceSheet As Worksheet, StartColumn As Long, NumColumns As Long, FindValue As Variant, ReplaceValue As Variant)
Dim sourceRange As Range
Set sourceRange = sourceSheet.Cells(sourceSheet.Rows.Count, StartColumn).End(xlUp).Resize(1, NumColumns)
With sourceRange
.Offset(1, 0).Formula = .Formula
.Offset(1, 0).Replace _
What:=FindValue, _
Replacement:=ReplaceValue, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=True, _
SearchFormat:=False, _
ReplaceFormat:=False
End With
End Sub
I am trying to sort data based on an unknown range.
When i try to sort based on 2 keys i get a Sort Method of Range Class failed
Option Explicit
Sub PostReview()
Dim tWb As ThisWorkbook, ws As Worksheet
Dim Lastrow As Integer, LastCol As Integer
Dim I As Integer, j As Integer
Dim rng As Range, rng2 As Range
Set ws = Worksheets("TR Query")
'Sort by Portfolio & Audit Date
Worksheets("TR Query").Activate
Lastrow = Cells(Rows.Count, 2).End(xlUp).Row
With ws
.Range("B1:B" & Lastrow).Copy
.Range("N:N").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Set rng = Worksheets("TR Query").Range("N2:N" & Lastrow)
rng.Value = rng.Value
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set rng2 = .Range(.Cells(Lastrow, 1), .Cells(Lastrow, LastCol))
With rng2
.Cells.Sort Key1:=.Range("N1"), Order1:=xlAscending, _
Key2:=.Range("L1"), Order2:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
End With
i am hoping that the data is sorted first by column N from A to Z then sorted by column L from newest to oldest.
the error in my code is here:
With rng2
.Cells.Sort Key1:=.Range("N1"), Order1:=xlAscending, _ 'error happens here
Key2:=.Range("L1"), Order2:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
i'm not sure what i'm doing wrong.
I am trying to accelerate my Excel VB Macro.
I have tried the 5 alternatives below.
But I wonder if I could shorten the execution further.
I found 2 alternatives in User Blogs which I could not get to work.
One alternative is also found in a User Blog but do not understand.
Sub AccelerateMacro()
'
' v1 052817 by eb+mb
' Macro to copy as fast as possible sheet from one workbook into another workbooks
' Declarations for variables are not shown to make code example more legible
' Macro is stored in and run from "DestinationWorkBook.xlsm"
StartTime = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Alternative = "First"
If Alternative = "First" Then
Workbooks.Open Filename:="SourceWorkBook.xls"
Cells.Select
Selection.Copy
Windows("DestinationWorkBook.xlsm").Activate
Sheets("DestinationSheet").Select
Range("A1").Select
ActiveSheet.Paste
Windows("SourceWorkBook.xls").Activate
ActiveWorkbook.Close
End If
If Alternative = "Second" Then
Workbooks.Open Filename:="SourceWorkBook.xls", ReadOnly:=True
Cells.Select
Selection.Copy
Windows("DestinationWorkBook.xlsm").Activate
Sheets("DestinationSheet").Select
Range("A1").Select
ActiveSheet.Paste
Workbooks("SourceWorkBook.xls").Close SaveChanges:=False
End If
If Alternative = "Third" Then
' I could not get this alternative to work
Workbooks.Open("SourceWorkBook.xls").Worksheets("SourceSheet").Copy
Workbooks.Open("DestinationWorkBook.xlsm").Worksheets("DestinationSheet").Range("A1").PasteSpecial
End If
If Alternative = "Fourth" Then
' I could not get this alternative to work
Workbooks.Open("DestinationWorkBook.xlsm").Worksheets("DestinationSheet").Range("A1") = Workbooks.Open("SourceWorkBook.xls").Worksheets("SourceSheet")
End If
If Alternative = "Fifth" Then
' I don't understand the code in this alternative
Dim wbIn As Workbook
Dim wbOut As Workbook
Dim rSource As Range
Dim rDest As Range
Set wbOut = Application.Workbooks.Open("DestinationWorkBook.xlsm")
Set wbIn = Application.Workbooks.Open("SourceWorkBook.xls")
With wbIn.Sheets("SourceSheet").UsedRange
wbOut.Sheets("DestinationSheet").Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
End With
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
Instead of using UsedRange, find the actual Last Row and Last Column and use that range. UsedRange may not be the range that you think it is :). You may want to see THIS for an explanation.
See this example (UNTESTED)
Sub Sample()
Dim wbIn As Workbook, wbOut As Workbook
Dim rSource As Range
Dim lRow As Long, LCol As Long
Dim LastCol As String
Set wbOut = Workbooks.Open("DestinationWorkBook.xlsm")
Set wbIn = Workbooks.Open("SourceWorkBook.xls")
With wbIn.Sheets("SourceSheet")
'~~> Find Last Row
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Find Last Column
LCol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Column Number to Column Name
LastCol = Split(Cells(, LCol).Address, "$")(1)
'~~> This is the range you want
Set rSource = .Range("A1:" & LastCol & lRow)
'~~> Get the values across
wbOut.Sheets("DestinationSheet").Range("A1:" & LastCol & lRow).Value = _
rSource.Value
End With
End Sub