I am trying to use the Lastcolumn from Sheet D in a formula in Sheet M. This is the code I have: D!R[8]C " & LastColumn1 & .
But it looks like the code is using the last column number in sheet M.
Can you please check what is wrong with this code?
Sub misc()
Dim LastColumn1 As Long
LastColumn1 = ActiveWorkbook.Worksheets("D").Range("a12").End(xlToRight).Column
End Sub
Sub try()
Sheet1.Select
Range("A4").Select
ActiveCell.End(xlToRight).Offset(-2, 1).Value = counter & "Qtr"
Do While ActiveCell.Value <> ""
ActiveCell.End(xlToRight).Offset(0, 1).Formula = "=IFERROR(D!R[8]C " & LastColumn1 & " *(1+INDEX(A!R3C4:R418C27,MATCH(M!R2C,A!R2C4:R2C27,0))),0)"
ActiveCell.Offset(1, 0).Select
Loop
End Sub
You need a function for this.
Function LastColumn() as long
LastColumn = ThisWorkbook.Worksheets("D").Range("a12").End(xlToRight).Column
end function
And then you call that function directly from your code:
Sub try()
Sheet1.Select
Range("A4").Select
lastCol = LastColumn '## Calling the function from above
ActiveCell.End(xlToRight).Offset(-2, 1).Value = counter & "Qtr"
Do While ActiveCell.Value <> ""
ActiveCell.End(xlToRight).Offset(0, 1).Formula = "=IFERROR(D!R[8]C " & lastCol & " *(1+INDEX(A!R3C4:R418C27,MATCH(M!R2C,A!R2C4:R2C27,0))),0)"
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Can you please check what is wrong with this code?
You have an undeclared/uninitialized variable called LastColumn1 which you are using in a formula string. This variable has no value at runtime, which causes the error.
How to resolve it:
If you had simply used Option Explicit, you would be informed of a compilation error. LastColumn1 variable is undeclared within the scope of the try() procedure.
Since you are not using Option Explicit (which requires that all variables be declared), the compiler initializes undeclared variables as type Variant, with an empty/0/null-string value.
So, what you have essentially is an obvious error with:
ActiveCell.End(xlToRight).Offset(0, 1).Formula = _
"=IFERROR(D!R[8]C " & EMPTY & " * _
(1+INDEX(A!R3C4:R418C27,MATCH(M!R2C,A!R2C4:R2C27,0))),0)"
Because the result of that concatenation is: D!R[8]C and that is an invalid Range (without a column index), it is undefined/cannot exist as such.
Using #iDevelop's function above will probably suffice for most ordinary, simple cases, however you may want to review the more robust methods described here:
Error in finding last used cell in VBA
Related
I've inherited some VBA code that attempts to save and restore filters in Excel 2010-2016 (I'm testing on Excel 2016 - 32bit, 16.0.4549.1000). I've already learned this is pretty much impossible to do properly and in a sane way (e.g. Get Date Autofilter in Excel VBA), but the number of different ways it can fail amazes me.
In particular, it seems that an xlFilterValues filter, which selects cells with value longer than 254 characters, can not be saved and restored:
the values in .Criteria1(i) are truncated to 256 chars when reading,
if you save the criteria array (saved = .Criteria1) and attempt to restore it later via .AutoFilter Criteria1:=saved ..., the .AutoFilter will report "Run-time error '13' Type Mismatch" if any Len(saved(i)) >= 256
The testcase, which can be run in an empty workbook is listed below.
Can everyone reproduce? Any thoughts on an easy way around this limitation?
Sub test()
Const CRITERIA_LEN = 257 ' 255 or less works, 256 throws error
Dim ws As Worksheet: Set ws = ActiveSheet
Dim filtRng As Range: Set filtRng = ws.Range(ws.Cells(1, 1), ws.Cells(5, 1))
Dim s100 As String: s100 = "1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"
Const PREFIX_LEN = 2 ' the length of the "=X" prefix in Criteria1(i)
Dim longStr As String: longStr = Mid(s100 & s100 & s100, 1, CRITERIA_LEN - PREFIX_LEN)
ws.Cells(1, 1).Value2 = "header"
ws.Cells(2, 1).Value2 = "A" & longStr
ws.Cells(3, 1).Value2 = "B" & longStr
ws.Cells(4, 1).Value2 = "C" & longStr
ws.Cells(5, 1).Value2 = "another value"
If Not ws.AutoFilterMode Then
filtRng.AutoFilter
End If
SET_BREAKPOINT_HERE = 1
' after hitting the breakpoint use the autofilter to select the three long values by typing '123' into the autofilter search
Dim fs As Filters: Set fs = ws.AutoFilter.Filters
If Not fs.Item(1).On Then Exit Sub
Debug.Print "Operator = " & fs.Item(1).Operator ' should be xlFilterValues (7)
Debug.Print "Len(.Criteria1(1)) = " & Len(fs.Item(1).Criteria1(1)) ' this is never larger than 256
Debug.Print "Len(.Criteria1(2)) = " & Len(fs.Item(1).Criteria1(2))
Debug.Print "Len(.Criteria1(3)) = " & Len(fs.Item(1).Criteria1(3))
' Save the filter
Dim crit As Variant
crit = fs.Item(1).Criteria1
'crit = Array("=A" & longStr, "=B" & longStr, "=C" & longStr) ' This line has the same effect
ws.AutoFilter.ShowAllData ' reset the filter
' Try to restore
filtRng.AutoFilter Field:=1, _
Criteria1:=crit, _
Operator:=xlFilterValues
' => Run-time error '13' Type Mismatch
End Sub
I just came across this issue today also. Really unfortunate that this has this limitation. I think the best thing we can hope to do is the following.
Function MakeValid(ByVal sSearchTerm as string) as string
if len(sSearchTerm) > 255 then
MakeValid = Left(sSearchTerm,254) & "*"
else
MakeValid = sSearchTerm
end if
End Function
Sub Test()
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= MakeValid(sSearchTerm), Operator:=Excel.XlAutoFilterOperator.xlFilterValues
End Sub
Ultimately, the way it works, is it bypasses the problem by using a pattern search (so matches the first 253 characters, and then it searches for any pattern from there). This won't always work, in fact it is bound to not work at some points, but it seems this is the best option we have (other than designing our systems around this issue)
Seems like this also works for arrays:
Function MakeValid(ByVal sSearchTerm as string) as string
if len(sSearchTerm) > 255 then
MakeValid = Left(sSearchTerm,254) & "*"
else
MakeValid = sSearchTerm
end if
End Function
Sub Test()
Dim i as long
for i = lbound(sSearchTerms) to ubound(sSearchTerms)
sSearchTerms(i) = MakeValid(sSearchTerms(i))
next
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= sSearchTerms, Operator:=Excel.XlAutoFilterOperator.xlFilterValues
End Sub
It's kinda a bad solution but it sort of works
I want to pass all cells in a certain range in column O and to delete all rows that do not contain values: OI and SI.
My code shows me an error at:
If Selection.Value <> "SI" Or "OI" Then
as a type mismatch
Sub CHECK()
Dim MFG_wb As Workbook
Dim Dep As Integer
Dim I As Integer
Set MFG_wb = Workbooks.Open _
("C:\Users\rosipov\Desktop\eliran\MFG - GSS\MFG Daily\Fast Daily " & Format(Now(), "ddmmyy") & ".xlsx", _
UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
MFG_wb.Sheets("Aleris").Activate
Dep = MFG_wb.Sheets("Aleris").Range("O2", Range("O2").End(xlDown)).Count
Range("O2").Select
For I = 1 To Dep
If Selection.Value <> "SI" Or "OI" Then
EntireRow.Delete
Else
Selection.Offset(1, 0).Select
End If
Next I
End Sub
Try this code to solve your problem. It not only fixes the problematic line, but it avoids some other pitfalls as well that will inevitably cause issues in the long run.
Sub CHECK()
Dim ManufacturingFile As Workbook
Set ManufacturingFile = Workbooks.Open _
("C:\Users\rosipov\Desktop\eliran\MFG - GSS\MFG Daily\Fast Daily " & Format(Now(), "ddmmyy") & ".xlsx", _
UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
Dim Aleris As Worksheet
Set Aleris = ManufacturingFile.Worksheets("Aleris")
Dim TotalRows As Long
TotalRows = Aleris.Range("O2", Aleris.Range("O2").End(xlDown)).Count
' Avoid Select at all costs
' Range("O2").Select
Dim i As Long
For i = TotalRows To 1 Step -1
If Aleris.Range("O" & i).Value <> "SI" And Aleris.Range("O" & i).Value <> "OI" Then
Aleris.Rows(i).Delete
End If
Next i
End Sub
First, your issue was caused by If Selection.Value <> "SI" Or "OI" Then because "OI" cannot be evaluated as a Boolean statement. Behind the scenes, the interpreter tried to convert "OI" to True or False but was unable to. As a result, you get an error. The fix is simple:
If Selection.Value <> "SI" or Selection.Value <> "OI" Then. Now we have two Boolean statements, both checking for equality. The interpreter is happy with this and can run just fine.
Beyond this, I fixed your unqualified range references, and your practice of Activate and Select. Despite some of the suggestions from others, both of these are very bad habits. Your code will break, and it will cost you. Don't believe me? Read pretty much any other post about Activate and Select and you'll see the same thing.
Why is this a bad idea? You have absolutely no control over what the ActiveSheet is during run-time. Sure you can Activate it, but there will be that time where something comes in and changes the focus to another sheet, and then you'll have issues. This one bug can literally cost hours of work if you're not careful.
The fix is simple. Just declare a variable (as you almost had), and use that variable. Voila! No more worrying about having the wrong sheet.
Finally, Excel is really good at understanding what you mean when you use indices to reference parts of the sheet. You don't have to Selection.Offset(1, 0).Select and then Selection.EntireRow.Delete since all this really means is ActiveSheet.Rows(Selection.Row + 1).Delete and we can refactor that further to use a worksheet, and an index to Foo.Rows(i + 1).Delete. See the pattern here? Become more abstract, step by step, until your code becomes solid.
The last thing I changed was your variable names. Use descriptive names, it makes your code easier to maintain. Also, never ever use underscores "_" in names until you understand Interfaces. Underscores have special meaning to the interpreter.
Finally, check out the Rubberduck project : rubberduckvba.com. It is a free add-in that is dedicated to improving the VBA coding experience. The best part? Most of this feedback is built into RD as inspections. It does the work for you, and you get to learn in the process.
Best of luck!
As Luuklag mentioned, start at the bottom. Also best get the xlLastCell (does not stop at blank cell) to count the rows and adjust the if statement to check for both SI and OI:
Dep = MFG_wb.Sheets("Aleris").Range("O2").SpecialCells(xlLastCell).Row
For I = Dep To 2 Step -1
Cells(I, 15).Select
If Not (Selection.Value = "SI" Or Selection.Value = "OI") Then
Rows(I).Delete
End If
Next I
Individual deleting row is slow.(This delete row many times, so it takes a long time to delete)
After merge range, delete merged range at once.(use Union method)
Sub CHECK()
Dim MFG_wb As Workbook
Dim Dep As Long
Dim i As Long '<~~ if your data is large then use long
Dim Ws As Worksheet
Dim s As String
Dim rngU As Range
Set MFG_wb = Workbooks.Open _
("C:\Users\rosipov\Desktop\eliran\MFG - GSS\MFG Daily\Fast Daily " & Format(Now(), "ddmmyy") & ".xlsx", _
UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
'MFG_wb.Sheets("Aleris").Activate
Set Ws = MFG_wb.Sheets("Aleris") '<~~ instead activate, use variable
With Ws
Dep = .Range("O2").End(xlDown).Row
'Range("O2").Select '<~~ select mothod is not goo.
For i = 2 To Dep
s = .Range("o" & i)
If s = "SI" Or s = "OI" Then
Else
If rngU Is Nothing Then
Set rngU = .Range("o" & i)
Else
Set rngU = Union(rngU, .Range("o" & i))
End If
End If
Next i
End With
If rngU Is Nothing Then
Else
rngU.EntireRow.Delete
End If
MFG_wb.Save
MFG_wb.Close (0)
End Sub
Just fix line
If Selection.Value <> "SI" Or "OI" Then
To
If Selection.Value <> "SI" Or Selection.Value<>"OI" Then
Once you activated sheet with MFG_wb.Sheets("Aleris").Activate you don't need to explicitly use it with Range objects. After mentioned line, the code should look like:
Dim s As Sheet
Set s = MFG_wb.Sheets("Aleris")
'determine last row in O column
Dep = s.Cells(s.Rows.Count, 15).End(xlUp).Row
For I = 1 To Dep Step -1
If InStr(1, s.Cells(I, 15).Value, "SI") + InStr(1, s.Cells(I, 15).Value, "OI") = 0 Then
s.Cells(I, 15).EntireRow.Delete
End If
Next I
Main reason for the change in a code you posted is that you are using Select method, which isn't a good practice. If you'd be interested, I advise you read why you should avoid using such funtions.
The below code is working fine with me. I need your help and support to make it a function so I can for example write in any cell
=adj() or =adj(A1) and the formula will apply,
Sub adj()
Dim i, j As Integer
Sheet1.Select
With Sheet1
j = Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, -2)).Value
For i = 1 To j
ActiveCell.Formula = "=" & Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It's hard for me to definitively understand what you're trying to do here. I think you're trying to concatenate x number of cells with a separator field.
So, I would do the following changes... obviously you can change accordingly.
Declare the Inputs as variants. If you don't and get a type mismatch the function wont call in debug. This also gives you the opportunity to deal with the Inputs.
Put in an error handler to prevent unwanted debug w.r.t. a failure.
You can't use Evaluate that way. I think you're trying to get an Evaluation of cells like A1 etc.
The function has to be called from a Cell on a sheet since it uses Application.Caller. You shouldn't really need this for the function to work, but I put in in there in case you are calling via F9 calculation.
You can also put in the line if you want the calculation to occur every time you recalculate. However this should be used with caution since you can get some unwanted calculation side effects with some spreadsheets when using this.
Application.Volatile
Public Function Adj(ByVal x As Variant, ByVal y As Variant) As String
On Error GoTo ErrHandler
Dim sSeparator As String, sCol As String
Dim i As Integer
'Get the column reference.
sCol = Split(Columns(y).Address(False, False), ":")(1)
'Activate the sheet.
Application.Caller.Parent.Select
sSeparator = Chr(10)
For i = 1 To x
Adj = Adj & Evaluate(sCol & i) & sSeparator
Next
'Remove the last seperator...
Adj = Left(Adj, Len(Adj) - 1)
Exit Function
ErrHandler:
'Maybe do something with the error return value message here..
'Although this is a string, Excel will implicitly convert to an error.
Adj = "#VALUE!"
End Function
If you wanted to pass change to a formula, and pass in the range, you would use something like:
Public Function Func(Byval MyRange as range) as variant
In this case, you're not specifying a return value so it will be ignored.
Public Function Func(Byval MyRange as range) as variant
Dim i, j As Integer
With MyRange.parent
j = .Range(MyRange.Offset(0, -2), MyRange.Offset(0, -2)).Value
For i = 1 To j
MyRange.Formula = "=" & .Range(MyRange.Offset(0, -1), MyRange.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It would be something like that..
So yesterday I posted my first SO question, and it went down like a ton of bricks. However I've picked myself up, dusted myself off, and hopefully this question will be more acceptable... :-)
I am trying to remove data duplicates from a list of Health Questionnaires I have to monitor, but the tricky bit I was struggling with was finding a duplicate in one column, AND then checking that the data on the same row, for the 3 adjacent columns were also duplicates. Storing the searched for 'duplicated row' was the bit that was throwing me off.
Here's some code I've cobbled together from other similarly-functioning scripts. I'm now in debug mode and keep getting errors thrown up... I don't have much experience of VBA, so i'm running out of options.
I'm currently getting type mismatch errors with the variable g, and also firstAddress. Why are these causing problems???
Can I call firstAddress.Row or am I barking up the wrong tree?
Here's the snippet:
g = .Find(Range("G" & i).Text, LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
dupRow = firstAddress.Row
And here's the whole code below. Any help would be much appreciated!
Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Integer
Dim firstAddress As Integer
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range
'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)
Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lw 'Find duplicates from the list.
If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
With Worksheets("Still In Progress").rngFirst
g = .Find(Range("G" & i).Text, LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
dupRow = firstAddress.Row
If Range("H" & dupRow).Text = Range("H" & i).Text _
And Range("I" & dupRow).Text = Range("I" & i).Text _
And Range("J" & dupRow).Text = Range("J" & i).Text Then
'select the entire row
Range.EntireRow.Select
'copy the selection
Selection.Cut
'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Worksheets("Completed")
objNewSheet.Select
'Looking at your initial question, I believe you are trying to find the next available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
'delete the initial row
rngCell.EntireRow.Delete
Set g = .FindNext(g)
Loop While Not g Is Nothing And g.Address <> firstAddress
End If
End With
Next i
End Sub
I went through your code carefully. There were a number of problems. Some of these I think I was able to fix - there was one where I guessed what you intended to do, but for one of them I just marked it; you need to explain what you were trying to do, as you are deleting a range that you never defined...
The first problem is with the line:
If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
The CountIf function returns a number; you are comparing this number with the string "Complete". I don't think you can ever get past this line, so the rest of the code (whether correct or not) will not execute. Not entirely clear what you are trying to do in this line, as I'm not sure when a line will be marked "Complete" - but assuming that you are interested in executing the rest of the code if the cell in A & i has the string "Complete" in it, then you probably want to do
If Range("A" & i).Text = "Complete" Then
There were a number of If - Then, With, and Loop structures that were not properly terminated with a matching End. I have tried to remedy this - make sure I did it right. Note that using proper indentation really helps to find problems like this. The space bar is your friend...
Since the Find method returns an object, the correct way to use the function is
Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)
Apart from that - use Option Explicit at the top of your code, and define variables with the most restrictive (correct) type that you can. When I did this I found the error I could not correct - with the rngCell variable that was neither declared, nor ever set... It shows just how helpful it can be. Also good for catching typos - VBA will happily let you write things like
myVar = 1
MsgBox myVra + 1
The message will be 1, not 2, because of the typo... The fact that Explicit should even be an option is one of the many inexplicable design decisions made by the VBA team.
Here is your code "with most of the errors fixed". At least like this it will compile - but you must figure out what to do with the remaining error (and I can't be sure I guessed right about what you wanted to do with the cell marked "Complete").
Comments welcome.
Option Explicit
Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Range
Dim firstAddress As Range
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range
'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)
Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lw 'Find duplicates from the list.
' If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
If Range("A" & i).Text = "Complete" Then
'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
With Worksheets("Still In Progress").rngFirst
Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
dupRow = firstAddress.Row
If Range("H" & dupRow).Text = Range("H" & i).Text _
And Range("I" & dupRow).Text = Range("I" & i).Text _
And Range("J" & dupRow).Text = Range("J" & i).Text Then
'select the entire row
g.EntireRow.Select
'copy the selection
Selection.Cut
'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Worksheets("Completed")
objNewSheet.Select
'Looking at your initial question, I believe you are trying to find the next available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
'delete the initial row
rngCell.EntireRow.Delete ' <<<<<< the variable rngCell was never defined. Cannot guess what you wanted to do here!
Do
Set g = .FindNext(g)
Loop While Not g Is Nothing And g.Address <> firstAddress
End If ' entire row matched
End If ' Not g Is Nothing
End With ' With Worksheets("Still in Progress")
End If ' CountIf = "Complete"
Next i
End Sub
Another handy trick: when you "paste in the next available row" as you are doing with Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select, I usually find it handy to do something like this instead:
Dim destination As Range
Set destination = Worksheets("Sheetname").Range("A1")
And when you need to paste something:
destination.Select
ActiveSheet.Paste
Set destination = destination.Offset(1,0)
This way, destination is always pointing to the "next place where I can paste". I find it helpful and cleaner.
Pretty new to VBA but I'm learning quickly.
I'm finally getting used to using loops to perform repetitive tasks, and in this case, I want each pass through the loop to define a different variable. I'd be defining a list as a string and pushing a value to each part of the list for each loop.
Obviously, the number of loops is variable, so I need the end point of the defined list to be a variable. From what I've searched, that's not possible? I'm getting a "constant expression required" error.
Here is the code (lastRow is already defined):
NextAverage = 0
section = 1
Dim AverageSection(1 To section) As String
For section = 1 To PhraseSections
ActiveCell.Formula = "=MATCH(""average"",A" & NextAverage + 1 & ":A" & lastRow & ",0)"
Selection.Offset(1, 0).Select
ActiveCell.Formula = "=SUM(G1:G" & section & ")"
NextAverage = ActiveCell.Value
AverageSection(section) = ActiveCell.Value
Next section
Any help would be greatly appreciated!
Try using Redim Preserve:
Dim AverageSection() As String
For section = 1 To PhraseSections
Redim Preserve AverageSection(section)
...
Next section
Does this help?