Error 1004: the range object cannot be excuted.
Hello Gurus, I'm a newbee in Excel VBA. I just try to add automatic sorting with alphabatic order to all my worksheets in a workbook. At most worksheets, the following code works perfect. But at several worksheets in this workbook, it doesn't und returns the runtime error as the screenshot shows. I can't figure out why, really strange.The worksheets have the simplest exact same structures. Thanks a lot!
Dim r As Integer
Dim c As Integer
r = ActiveCell.Row
c = ActiveCell.Column
Application.ScreenUpdating = False
Sheets(17).Select
Range("A8:E30").Select
Selection.Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells(r, c).Select
Application.ScreenUpdating = True
Related
I have a range of dates which I need to convert to 'MM/DD/YYYY format (but as text) every month.
I used to manually convert these by using this formula =TEXT(Cell Ref.,"MM/DD/YYYY"). See picture above. I have recently started using below VBA code to save my time (there are around 18 columns with 200K rows worth of data every month).
Sub MM_DD_YYYY()
Application.ScreenUpdating = False
Dim rng As Range
Selection.NumberFormat = "0"
For Each rng In Selection
rng.Value = "+text(" & rng.Value & ",""MM/DD/YYYY"")"
Next rng
Selection.TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
This code works fine if I select one column but fails if I select multiple columns because it has text to column element (which obviously only works for one column at a time). Is it possible to run the code one column at a time after selecting entire range without breaking it?
By the way, I have tried below alternatives of text to column:
Simulating F2+Enter. This works but takes a lot of time.
For Each rng In Selection
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Next
Doesn't work for some reason.
Selection.Value = Selection.FormulaR1C1
Doesn't work for some reason.
For Each rng In Selection
Selection.Value = Selection.Value
Next rng
I would really appreciate your help or suggestion here. Thanks.
The output has a apostrophe at the beginning i.e. it's a text. That is why I was using text formula. Selection.NumberFormat = "MM/DD/YYYY" also doesn't work. range of dates are actual dates but output should be a text. – ram singh 12 secs ago
Try this. For explanation see Convert an entire range to uppercase without looping through all the cells. The below code uses INDEX() and TEXT().
Option Explicit
Sub Sample()
Dim rng As Range
Dim sAddr As String
Set rng = Range("A1:C5") '<~~ Change this to relevant range
sAddr = rng.Address
rng = Evaluate("index(""'"" & Text(" & sAddr & ",""MM/DD/YYYY""),)")
End Sub
BEFORE:
AFTER:
EDIT
#SiddharthRout Just curious, is it possible to make it to work for more than one range. Example, I have dates in Col A and Col C (Col B has some other data). Current code doesn't work because if I select only Col A and Col C, they are now 2 ranges. Any thoughts? – ram singh 15 mins ago
Is this what you want?
Option Explicit
Sub Sample()
Dim rng As Range
Dim ar As Range
Dim sAddr As String
Set rng = Range("A1:A5,C1:C5") '<~~ Sample range
For Each ar In rng.Areas
sAddr = ar.Address
ar = Evaluate("index(""'"" & Text(" & sAddr & ",""MM/DD/YYYY""),)")
Next ar
End Sub
BEFORE:
AFTER:
I have written a VBA macro which will sort rows based on user inputs. So if an user inputs 1, then the sorting will happen based on a certain condition, if 2 then an another condition and so on. However when I run the code I get the error "Run Time error 1004: Sort method of Range class failed". Can any of the VBA experts help how I can overcome this error. Below is the entire code block :
Public Sub Sortlist()
Dim userinput As String
Dim tryagain As Integer
userinput = InputBox("1 = Sort By Division,2 = Sort by Category, 3 = Sort by Total sales")
If userinput = "1" Then
DivisionSort
ElseIf userinput = "2" Then
CategorySort
ElseIf userinput = "3" Then
TotalSort
Else
tryagain = MsgBox("Incorrect Value.Try again?", vbYesNo)
If tryagain = 6 Then
Sortlist
End If
End If
End Sub
------------------------------------
Sub DivisionSort()
'
' Sort List by Division Ascending
'
'
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
----------------------------------------------
Sub CategorySort()
'
' Sort List by Category Ascending
'
'
Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
--------------------------------
Sub TotalSort()
'
' Sort List by Total Sales Ascending
'
'
Selection.Sort Key1:=Range("F4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
CurrentRegion Saves the Day
Your code was failing when your Selection was out of range. So I created a Sub with one argument called SortRange which uses CurrentRegion to always 'point' to the range.
Option Explicit
Public Sub Sortlist()
Dim userinput As String
Dim tryagain As Integer
userinput = InputBox("1 = Sort By Division,2 = Sort by Category, 3 = Sort by Total sales")
If userinput = "1" Then
DivisionSort
ElseIf userinput = "2" Then
CategorySort
ElseIf userinput = "3" Then
TotalSort
Else
tryagain = MsgBox("Incorrect Value.Try again?", vbYesNo)
If tryagain = 6 Then
Sortlist
End If
End If
End Sub
'------------------------------------
Sub SortRange(rng As Range)
rng.CurrentRegion.Sort Key1:=rng, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
'------------------------------------
Sub DivisionSort()
'
' Sort List by Division Ascending
'
SortRange Range("A4")
End Sub
'----------------------------------------------
Sub CategorySort()
'
' Sort List by Category Ascending
'
SortRange Range("B4")
End Sub
'--------------------------------
Sub TotalSort()
'
' Sort List by Total Sales Ascending
'
SortRange Range("F4")
End Sub
I had the same issue when doing an online Excel VBA course. Likely the same course. The error was in the course supplied spreadsheet. I managed to troubleshoot the problem and it was relating to this issue found on the web.
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/block-if-without-end-if?
So a simpler fix but then my PC rebooted and I lost the macro that I edited and got to work.
I tried the VBasic2008 "Fix" and that works perfectly fine as well.
Just my comments on what I went thru, not trying to persuade or dissuade otherwise.
Barry
So, in a workbook I have a lot of sheets from which I want to use texttocolumns for a Date, the date is usually something like "11/22/2018 10:59:59 AM" and I only want it to do a MDY with a delimited text to columns. The delimiter must be false.
Sub LoopCertain() 'Excel VBA to exclude sheets
'SP Edit, error handler
On Error Goto errHandler
If False Then
errHandler:
MsgBox Err.Description
'This will cause the routine to carry on where it left off
Resume Next
End If
'SP End of Edit
Dim ws As Worksheet
Dim objRange1 As Range
Dim objRange2 As Range
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case Is = "General", "Verification", "OEM Plant Summary"
'No Code here if excluded
Case Else
'Set up the ranges
Set objRange1 = Range("C:C")
Set objRange2 = Range("I:I")
Set ws = ActiveSheet
'Do the first parse
objRange1.TextToColumns _
Destination:=Range("C1"), _
DataType:=xlDelimited, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False, _
OtherChar:="-"
'Do the second parse
objRange2.TextToColumns _
Destination:=Range("I1"), _
DataType:=xlDelimited, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False, _
OtherChar:="-"
End Select
Next ws
End Sub
I get errors when trying to run this. I need to change Columns "I" and "C" and results must be in the same column. Appreaciate if you can help since I have been like the whole week trying different types of loops and nothing works. This one work if I remove the Loop though...
Here is the sample data:
A fixed width would probably be more appropriate. Your sample data leaves some unanswered questions but I'll assume a mmddyyyy (not mdyyyy) date format and data that either starts in row 1 or has a header label in row 1 with 10 or less characters.
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "General", "Verification", "OEM Plant Summary"
'No Code here if excluded
Case Else
With ws.Range("C:C")
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, xlMDYFormat), Array(10, xlSkipColumn))
End With
With ws.Range("I:I")
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, xlMDYFormat), Array(10, xlSkipColumn))
End With
End Select
Next ws
Why do you need to use TextToColumns? I would be tempted to convert the text to a proper date (meaning a date serial number) and then format the column in whichever way you want to display the date. The advantage of this method would be that you can actually retain the time value contained in the date if case you want to know it later but without displaying it.
However, since you are intending to manipulate the text I think the code below is more efficient. Please try it.
Sub ReformatDate()
Const FirstDataRow As Long = 1 ' change as appropriate
Dim Ws As Worksheet
Dim Rng As Range
Dim Arr As Variant
Dim C As Long
Dim i As Long
For Each Ws In Worksheets
If InStr(1, ",General,Verification,OEM Plant Summary", "," & Ws.Name, _
vbTextCompare) = 0 Then
With Ws
For C = 3 To 9 Step (9 - 3) ' columns C & I
Set Rng = .Range(.Cells(FirstDataRow, C), _
.Cells(.Rows.Count, C).End(xlUp))
Arr = Rng.Value
For i = 1 To UBound(Arr)
If Len(Arr(i, 1)) Then Arr(i, 1) = Split(Arr(i, 1))(0)
Next i
Rng.Value = Arr
.Columns(C).AutoFit
Next C
End With
Next Ws
End Sub
I have two sheets:
Database
Macro sheet: It has a row with dates that will be the headings of a table after the macro.
Objective: In the macro sheet take the value of the first date and look for its position in the database sheet. Then, in the database sheet, copy the entire column corresponding to the previously copied date.
I understand that the code should look something like this:
Sheets("Macro").Select
Range("K3").Select
Selection.Copy
Sheets("Database").Select
Cells.Find(What:=Selection.PasteSpecial xlValues, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Macro").Select
ActiveSheet.Paste
This code does not work, because the search part is not done well, I will appreciate some correction
Something along these lines.
Read this to learn the advantages of not using Select or Activate.
When using Find, always check first that your search term is found to avoid an error. For example, you cannot activate a cell that does not exist.
Sub x()
Dim r As Range
With Sheets("Database")
Set r = .Cells.Find(What:=Sheets("Macro").Range("K3").Value, lookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
Range(r, r.End(xlDown)).Copy Sheets("Macro").Range("A1")
End If
End With
End Sub
Loop through he header dates in the Macro worksheet. If any can be found in the header row of the Database worksheet, copy that column to the Macro worksheet under the header.
sub getDateData()
dim h as long, wsdb as worksheet, m as variant, arr as variant
set wsdb = worksheets("database")
with worksheets("macro")
for h=1 to .cells(1, .columns.count).end(xltoleft).column
m = application.match(.cells(1, h).value2, wsdb.rows(1), 0)
if not iserror(m) then
arr = wsdb.range(wsdb.cells(2, m), wsdb.cells(rows.count, m).end(xlup)).value
.cells(2, h).resize(ubound(arr, 1), ubound(arr, 2)) = arr
end if
next h
end with
end sub
I am having some difficulties with macros in Excel. I have a built a call logger in a workbook containing 2 macros:
macro A moves all the data from worksheet A into worksheet B;
macro B automatically sorts the data so one column is always in descending alphabetical order.
However, I can't get both macros to work at the same time. They both work individually but when I try to implement one macro into a workbook containing the other they seem to cancel each other out. Where am I going wrong? Is there a way of possibly combining the 2 macros, for example? Macros are below.
Macro A:
Sub Macro6()
' Macro6 Macro
Application.ScreenUpdating = False
Sheets("Logger").Select
Range("B4:I4").Select
Selection.Copy
Sheets("DATA").Select
Range("B4").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Logger").Select
Range("B4:I4").Select
Selection.ClearContents
End Sub
Macro B:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Range("H3").Sort Key1:=Range("H4"), _
Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
Thank you in advance for your assistance with this.