I have this bit of VBA that I've used on many Excel workbooks without issues. On a particular workbook, I'm getting a Runtime Error '13': Type Mismatch error as soon as it gets to the Cell = Trim(Cell) part. What could be causing this? I've looked through the data, but can't find anything out of the ordinary that would be messing it up.
Sub TrimHS()
Application.Cursor = xlWait
Application.ScreenUpdating = False
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A83:G" & LastRow).Select
Dim rng As Range, Cell As Range
Set rng = Selection
For Each Cell In rng
Cell = Trim(Cell)
Next Cell
Application.Cursor = xlDefault
End Sub
You have an error on a particular workbook, thus the Trim() gives error 13, if you are trying to trim it. Make sure that you have no error before trimming:
For Each Cell In rng
If Not IsError(Cell) Then
Cell = Trim(Cell)
End If
Next Cell
To see what is wrong with the code, write debug.print Cell before the Trim line. It would start printing a lot at the console, the last line to print should look like this: Error 2007 or similar.
This will show the cell with the error in a MsgBox and its Worksheet:
For Each Cell In rng
If Not IsError(Cell) Then
Cell = Trim(Cell)
Else
MsgBox "Error on " & Cell.Address & " in " & Cell.Parent.Name
End If
Next Cell
Cell is of type Excel.Range and Trim outputs of type String
I believe cell.value=trim(cell.value) is what you'll need
Related
I am trying to use the offset function and cannot figure out the problem with my synatx.
I copied this code from another question about offset on this website.
I want to look for a string in column X (starting at X9 always) and if present, I want to know the value of the cell that is two columns over and in the same row.
I would like to use the offset value in an additional part of the same code, so it needs to be named as a variable, but I decided to see if I could first get VBA to at least read the information I want, hence the message box.
Here is the code:
Private Sub CommandButton3_Click()
Dim LeftStrike As Range
Dim FrameLeftStrike As Range
Dim lastRow As Long
lastRow = Range("X" & Rows.Count).End(xlUp).Row
Set LeftStrike = Range("X9:X" & lastRow)
Set FrameLeftStrike = Range("LeftStrike").Offset(0, 4).Value
For Each FrameLeftStrike In LeftStrike
If InStr(1, LeftStrike.Value, "Foot Strike") > 0 Then
MsgBox FrameLeftStrike
End If
Next FrameLeftStrike
End Sub
The variable "FrameLeftStrike" is the problem.
I receive:
application defined or object defined error.
I tried different iterations.
If I change the line of code to,
Set FrameLeftStrike = Sheet4.Range("LeftStrike").Offset(0, 4).Value
I get the same error.
If I change it to
Set FrameLeftStrike = LeftStrike.Offset(0, 4).Value
I get
run-time error '424' Object required.
I want to use this code in the active sheet only, but the name of the active sheet will change as it will get copied as a template for other projects.
Loop through each cell (my_cell) in Column X (my_range)
Individually check if the cell contains Foot Strike
If so, return the value 2 cells to right in a MsgBox
Sub test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update
Dim my_range As Range, my_cell As Range
Dim lr As Long
lr = ws.Range("X" & ws.Rows.Count).End(xlUp).Row
Set my_range = ws.Range("X9:X" & lr)
For Each my_cell In my_range
If InStr(my_cell, "Foot Strike") Then
MsgBox my_cell.Offset(0, 2)
End If
Next my_cell
End Sub
I have a macro that deletes a selected table row in a protected sheet in Excel, and am receiving the error in the title whenever the code is run. This issue started occuring when I introduced 10 Conditional Format rules to the worksheet, and if I clear the worksheet of any conditional formats, I'm able to delete as many rows as I like. My code to delete the table row below, as well as where the debug is pointing to clear the error.
Sub DeleteRow()
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheet1.Unprotect Password:="Password!"
Dim rng As Range
On Error Resume Next
With Selection.Cells(1)
Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "Please select a valid table cell.", vbCritical
Else
rng.Delete xlShiftUp 'This is the line where the debug is pointing to
End If
End With
Sheet1.Protect Password:="Password!"
Application.EnableEvents = True
End Sub
Thanks for your help!
*Update No #Ref! errors on any of my Conditional Format formulas.
**Update I have about 10 Conditional Format formulas, with slight variations below.
=AND(COUNTIFS($E$14:$E$17,$E14,$J$14:$J$17,"Black")>1,$J14="Black")
=AND(COUNTIFS($E$14:$E$17,$E14,$J$14:$J$17,"White")>1,$J14="White")
=AND(COUNTIFS($E$14:$E$17,$E14,$J$14:$J$17,"Green")>1,$J14="Green")
Most probably the conditional formatting is having a #REF! error somewhere, thus Excel does not allow the deletion. To see all the formulas in the conditional formats, run this:
Sub ListAllConditionalFormat()
Dim cf As FormatCondition
Dim ws As Worksheet
Dim l As Long
Dim rngCell As Range
On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("Report").Cells.Clear
For Each ws In ThisWorkbook.Worksheets
Debug.Print ws.Name
For Each cf In ws.Cells.FormatConditions
l = 1 + l
With Worksheets("Report")
Set rngCell = .Cells(l, 1)
rngCell = cf.AppliesTo.Address
rngCell.Offset(0, 1) = cf.Type
rngCell.Offset(0, 2) = "'" & cf.Formula1
rngCell.Offset(0, 3) = cf.Interior.Color
rngCell.Offset(0, 4) = cf.Font.Name
rngCell.Offset(0, 5) = ws.Name
rngCell.Offset(0, 6) = "'" & cf.AppliesTo.AddressLocal
rngCell.Offset(0, 7) = "'" & cf.Formula2
End With
Next cf
Next ws
Debug.Print "END!"
End Sub
Just make sure that you have a worksheet, named Report, where everything is empty. The information for the conditional formats would be there. Look for #REF! errors and fix them once you see them.
I just want to know how to loop through the non blank cells on Column A. What I'm trying to do is copy the contents on [A1:B1] to be added on top of each non blank cells on Column A. So far I have counted the non blank cells on column A but I'm stuck. I know that an Offset function should be used for this.
Here's my code so far:
Dim NonBlank as Long
NonBlank = WorksheetFunction.CountA(Worksheet(1).[A:A])
For i = 1 to NonBlank
[A1:B1].Copy Offset(1,0). "I'm stuck here"
Next i
If you are trying to fill the headers for each Product, try this...
Sub FillHeaders()
Dim lr As Long
Dim Rng As Range
lr = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:B1").Copy
For Each Rng In Range("A3:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas
If Rng.Cells(1).Value <> Range("A1").Value Then
Rng.Cells(1).Offset(-1, 0).PasteSpecial xlPasteAll
End If
Next Rng
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
As example to simulate the effect of Ctrl-Down from Cell A1 and display the Address, Value in the Immediate Window:
Sub HopToNextNonBlankCellBelow()
Dim oRng As Range
Set oRng = Range("A1")
Debug.Print "Cell Address", "Cell Value"
Do
Set oRng = oRng.End(xlDown)
If Not IsEmpty(oRng) Then Debug.Print oRng.Address(0, 0), oRng.Value
Loop Until oRng.Row = Rows.Count
Set oRng = Nothing
End Sub
Try this... I've (probably) overcounted the rows at 1000, but it likely won't make a difference with your performance. If you wanted to be more precise, there are hundreds of articles on how to find the last row of a range. As for the Offset function, it references a cell in relation to the one we're looping through. In the example below, the code is saying cell.offset(0,1) which means one cell to the right of the cell we are currently looping through. A clearer (less loopy!) example would be if you typed: Range("A10").offset(0,1) it would be the same as typing Range("B10")
Dim Cell As Range
For Each Cell In Range("A2:A1000").Cells
If Not IsEmpty(Cell) Then
Cell.Offset(0, 1).Value = Cell.Value
End If
Next Cell
Could someone help me please - I've got one worksheet, and on an entry of a code I need it to pull through certain set cells from that row and display them on the active sheet.
This is as far as I've got and might give some idea of how ignorant I am in the way of VBA, and it doesn't work.
Sub AddProduct()
On Error GoTo MyErrorHandler:
Dim Code As Long
Code = B4
Sheets("Code Input Sheet").Range(A9) = Application.VLookup(Code,Worksheets("Cost Sheet").Range("A2:XFD1048576"), 1, False)
ActiveCell.End(xlRight).Offset(0, 1).Select
Selection = Application.VLookup(Code, Worksheets("Cost Sheet").Range("A2:XFD1048576"), 2, False)
ActiveCell.End(xlRight).Offset(0, 1).Select
Selection = Application.VLookup(Code, Worksheets("Cost Sheet").Range("A2:XFD1048576"), 5, False)
ActiveCell.End(xlDown).Offset(1, 0).Select
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Code doesn't exist."
End If
End Sub
Hopefully this makes sense
Thanks
EDIT
I probably need to start from scratch, but here's basically what I need: The user to enter a code in B4, runs the macro through the button which looks up on the second Sheet if it exists, and pulls through three cells from that code's row to A9:C9 on the first sheet. Then hopefully the process can be repeated with the data going to the next row below. Hopefully this isn't too much of an ask!
Instead of the VLOOKUP use the Range.Find method:
Sub AddProduct()
Dim code As Variant
Dim c As Range
Dim ws As Worksheet
Dim lastrow As Long
Set ws = ActiveSheet
code = ws.Range("B4")
'Find code and set c to the cell
Set c = Worksheets("Cost Sheet").Range("A:A").Find(code)
If c is Nothing Then
'if the code is not found
MsgBox "Not Found"
Exit Sub
Else
'this finds the next empty row
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
ws.Range("A" & lastrow) = c
ws.Range("B" & lastrow) = c.Offset(, 1)
ws.Range("C" & lastrow) = c.Offset(, 4)
End If
End Sub
I have a spreadsheet which contains lots of function calls to request data. I am writing a function (in VBA) to check whether any of the cells contains an error value "#VALUE" etc.
At the moment I am iterating row by row, column by column and first checking if the cell contains a formula, then if it does, checking instr for "#VALUE", "#N/A" etc.
However, I was wondering whether it would be quicker simulating clicking a whole column in excel and then "ctrl + f" for a value... in VBA.
What would be the most efficient way? I am checking a sheet 27 columns x 1200 rows large.
EDIT Ive just realised there are some cells which have "#N/A" and this is because they do not contain a particular formula. I need to only search in cells which contain a particular formula.... is this possible?
EDIT2 I effectively need to record a macro which returns the resutls, exactly like "find all". I have used "find" and i can get a boolean, but "find all" doesnt record any VBA code....
You can use SpecialCells to return only cells containing errors.
Sub Demo()
Dim sh As Worksheet
Dim rng As Range, cl As Range
For Each sh In ActiveWorkbook.Worksheets
Set rng = Nothing
On Error Resume Next
Set rng = sh.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If rng Is Nothing Then
Debug.Print "No Errors"
Else
For Each cl In rng
If cl.Formula Like "*" Then ' <-- replace * with your criteria
Debug.Print cl.Address
End If
Next
End If
Next
End Sub
Given you wanted the most efficient method you could try this approach which avoids a slow range loop
Loops through SpecialCells formulae chichi contain errors (as per the other solution)
Uses Find to detect specific formulae rather than a simple loop through every cell in (1)
This code uses the R1C1 method to feed into the Find so the code changes this Application setting if necessary (and then back at the end)
I suggest you record the formula you wish to find to then enter this in. The big advantage of R1C1 notation is that it is agnostic of actual row and column location.
For example in A1 notation a formula of
=SUM(A1:A4) in A5 would require a different search for SUM(B1:B4) inB5`
in R1C1 this is =SUM(R[-4]C:R[-1]C) in both cases
code
Sub Demo()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim strAddress As String
Dim bRefSTyle
If Application.ReferenceStyle = xlA1 Then
Application.ReferenceStyle = xlR1C1
bRefSTyle = True
End If
For Each ws In ActiveWorkbook.Worksheets
Set rng1 = Nothing
On Error Resume Next
Set rng1 = ws.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If rng1 Is Nothing Then
Debug.Print ws.Name & ": No Formulae errors"
Else
'search errors for particular formula
'this sample looks for a formula which SUMS the four cells directly above it
Set rng2 = rng1.Find("=SUM(R[-4]C:R[-1]C)", , xlFormulas, xlWhole)
If Not rng2 Is Nothing Then
strAddress = rng2.Address
Set rng3 = rng2
Do
Set rng2 = rng1.Find("=SUM(R[-4]C:R[-1]C)", rng2, xlFormulas, xlWhole)
Set rng3 = Union(rng2, rng3)
Loop While strAddress <> rng2.Address
Debug.Print ws.Name & ": " & rng3.Address
Else
Debug.Print ws.Name & ": error cells, but no formulae match"
End If
End If
Next
'restore styles if necessary
If bRefSTyle Then Application.ReferenceStyle = xlA1
End Sub