I'm trying to delete rows on one worksheet based on a range in another worksheet. I think the problem here is probably something simple based on my limited VBA experience. Here is the code I've written:
Sub LimitedElements()
imax = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To imax
If Sheets("test").Cells(j, 1).Value = Sheets("Limited Elements").Range("A1:A10") Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
I get a message saying "Application-defined or object-defined error".
Can anyone tell me what I'm doing wrong? Or if this is just a dumb way to do this and I should be doing it differently?
Please see if below works for you:
Sub LimitedElements()
Dim imax As Integer
Dim a As Variant
Dim b As Range
Dim c As Object
Dim d As Integer
imax = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To imax
a = Sheets("test").Cells(i, 1).Value
Set b = Sheets("Limited Elements").Range("A1:A10")
Set c = b.Find(What:=a, LookIn:=xlValues)
If Not c Is Nothing Then
Sheets("test").Rows(i).EntireRow.Delete
i = i - 1
imax = imax - 1
End If
Next i
End Sub
Noted that it is not fine tuned and is intended to give you an understanding on how to approach the solution.
I added code to decrement i. I think I understand that the code can't tell which worksheet I'm specifying for deleting the row but I'm not sure what to do about it. I tried changing "Rows(i).EntireRow.Delete" to "Sheets("test").Rows(i).EntireRow.Delete" but I'm not sure if that's the right thing to do or not.
Some extra details to make things clearer:
Sheet "test" has about 1000 rows with unique numbers in column A. Sheet "Limited Elements" has about 100 rows with unique numbers column A. I want it it delete the rows in "test" that have values in column A that match the column A values in "Limited Elements".
Sub LimitedElements()
imax = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To imax
If Sheets("test").Cells(i, 1).Value = Sheets("Limited Elements").Range("A1:A10") Then
Sheets("test").Rows(i).EntireRow.Delete
i = i - 1
imax = imax - 1
End If
Next i
End Sub
I think the original problem was that I had Cells(j,1) instead of cells(i,1). Now I've fixed that but it gives me a type mismatch error which I think is due to comparing a single cell to a range.
At this point I think I'm just lost. I can't figure out how to change it so it works and does what I want it to do.
Related
I have created the following code to extract information from an excel table. But I am getting an error exactly at the if statement. I have even tried executing the code from a module and even from the worksheet level. I have read about this issue and it seems that selecting the sheet seems to be the main problem, but I have also tried but in vain I can't seem to find a solution. It would be really great if someone could help me with this. Thank you in advance.
Sub test()
Dim row As Double, col As Double, inc As Double
row = 2
col = 2
inc = 20
'Sheets("sche").Range("a1").Select
For row = 2 To 15
For col = 2 To 52
If (Cells(r, c).Font.Bold Or Left(Cells(r, c).Value, 2) = "BP") Then 'Error is happening here
Sheets("sche").Cells(inc, 2).Value = Sheets("sche").Cells(r, c).Value
inc = inc + 1
GoTo zone
Else: GoTo zone
End If
zone:
Next col
Next row
End sub
You have declared row and col as variables but are using r and c in your If...Then block.
A prime example of why you should add Option Explicit at the top of every module to prevent typo's and using undeclared variables.
I've adjusted your code and tested it OK:
Note: I removed the Else condition and GoTo Zone as they were redundant in your code (at least in the example you provided). Also although not a cause of your error it's not necesarry to encapsulate your entire If...Then condition in parentheses.
Sub test()
Dim row As Double, col As Double, inc As Double
row = 2
col = 2
inc = 20
'Sheets("sche").Range("a1").Select
For row = 2 To 15
For col = 2 To 52
If Cells(row, col).Font.Bold Or Left(Cells(row, col).Value, 2) = "BP" Then 'Error is happening here
Sheets("sche").Cells(inc, 2).Value = Sheets("sche").Cells(row, col).Value
inc = inc + 1
End If
Next col
Next row
End Sub
I've changed this:
If Cells(r, c).Font.Bold Or Left(Cells(r, c).Value, 2) = "BP" Then 'Error is happening here
Sheets("sche").Cells(inc, 2).Value = Sheets("sche").Cells(r, c).Value
To this:
If Cells(row, col).Font.Bold Or Left(Cells(row, col).Value, 2) = "BP" Then 'Error is happening here
Sheets("sche").Cells(inc, 2).Value = Sheets("sche").Cells(row, col).Value
Furthermore, it's good practice to expicitly reference your objects.
This is because, for example, the implicit reference for the Cells() property is the Active Worksheet:
Using this property without an object qualifier returns a Range object that represents all the cells on the active worksheet.
This can cause unexpected results if for example, you run your code whilst a different sheet than desired is active or a user changes worksheets during the codes execution.
It would be better to write the code like:
If Sheets("sche").Cells(row, col).Font.Bold Or Left(Sheets("sche").Cells(row, col).Value, 2) = "BP" Then
The With statement can come in handy to shorten the written code when making many references to the same objects, like workbooks, worksheets and/or Ranges etc. You can read about it in the documentation.
I'm new here and to VBA, and joined because a friend told me this community is helpful.
I'm currently having a problema in VBA that is as follow:
-The user chooses a code from a list in the Worksheet "Book Rent";
-This code is kept in Cell D10 and is saved by a Macro in another Sheet "Renting" where several data is saved form the form;
-Then in another Worksheet called "Books" there is the book code in column B, the title in column C and the quantity of books available in D;
-What I wanted is when the user rents the book, the quantity decrements by 1(I don't need a validation if the number is zero or not right now, so just the decrement is enough);
I have tried doing Sheets("Book Rent").Cells(10, "D") = Sheets("Books").Range("D5") - 1 but it gives me an error.
I am right now, trying to use a for loop but it also gives me na error.
If someone could give me some help or if you need more information I would be glad to help.
Here's my for loop:
Dim Looper As Integer
For Looper = 5 To Sheets("Livros").Cells(Looper, 2) = Sheets("Form Aluguer").Cells(10, "D")
Sheets("Livros").Cells(Looper, "D").Select
Cells(Looper, "D") = Cells(Looper, "D") - 1
Next Looper
Thank you by the way.
If you want to loop from X to Y (where X > Y) just use this:
For X = 5 to 0 Step - 1
Next
The Step command tells it how to increment X, and 0 is how long we are incrementing X until. Keep in mind that the For loop needs some number as the second argument, so you could do:
For X = 5 to Sheets("Form Aluguer").Cells(10, "D")
But you can only do this if Sheets("Form Aluguer").Cells(10, "D") contains a number.
If you want to loop while Sheets("Livros").Cells(Looper, 2) = Sheets("Form Aluguer").Cells(10, "D") you would need to do something like this:
Dim looper as Long
Do While Sheets("Livros").Cells(Looper, 2) = Sheets("Form Aluguer").Cells(10, "D")
looper = looper -1
Loop
EDIT:
Here is what I think you are looking for, I've left my original answer at the bottom of this post. But this code is more of a working version of what I think you need. It just may need to be adapted slightly depending on the layout of your workbook.
I have added more comments than I usually would due to you being new to VBA.
Hope this helps
Sub Decrement()
'Declare a BookCount variable to hold the value of the cell containing the number of books
Dim BookCount As Integer
'Declare a range to hold the range of the Books Quantity column
Dim QuantityRng As Range
'Dim two ranges to use during the loops
Dim RentCell As Range, BookCell As Range
'Declare and set a variable named RentRng to the Rental list and BookRng to the Book list's Code column
Dim RentRng As Range, BookRng As Range
Set RentRng = Worksheets("Renting").Range("A:A")
Set BookRng = Worksheets("Books").Range("B:B")
'For every cell in the Renting list
For Each RentCell In RentRng
'Stop the subroutine when the loop encounters a blank cell
If RentCell.Value = "" Then
Exit Sub
End If
'Check every cell in the Book code list
For Each BookCell In BookRng
'Exit the loop when encounters a blank cell so can look for the next book in the outer loop
If BookCell.Value = "" Then
Exit For
End If
'Check if the Rental worksheet Code Matches the Books worksheet code, and if so then decrements the field by one
If RentCell.Value = BookCell.Value Then
Set QuantityRng = BookCell.Offset(0, 2)
BookCount = QuantityRng.Value
BookCount = BookCount - 1
QuantityRng.Value = BookCount
End If
Next BookCell
Next RentCell
End Sub
I'm not sure whether I understood correctly, but I would start by declaring a variable named BookCount to hold the value of the cell in question. Then you can use BookCount = BookCount - 1
The problem you have there, is that you're trying to take 1 away from a range, when it's actually the value of the range that you are wanting to amend.
Then you can set the value of the range, to BookCount
Here's a small example
Sub Decrement()
Dim BookCount As Integer
BookCount = Range("A1").Value
BookCount = BookCount - 1
Range("A1").Value = BookCount
End Sub
I am having trouble figuring out how to subtract two ranges from each other, some cells in range H:H have "#N/A" while in range D:D there are no errors. I know in Excel it's a simple "=H2-D2" and drag that down but I'm in the process of recording a Macro and wanted to automate the subtraction as well. So far this is what I have:
Dim quantity1, quantity2, rIntersect, Qdiff, x As Range
Set quantity1 = Range("D:D")
Set quantity2 = Range("H:H")
Set rIntersect = Intersect(quantity1, quantity2)
For Each x In quantity1
If Intersect(rIntersect, x) Is Nothing Then
If Qdiff Is Nothing Then
Set Qdiff = x
Else
Set Qdiff = Application.Union(Qdiff, x)
End If
End If
Next x
Range("J2").Select
Dim lastRowJ As Long
lastRowJ = Range("A" & Rows.Count).End(xlUp).Row
Range("J2").AutoFill Destination:=Range("J2:J" & lastRowJ)
Place this procedure in a standard code module:
Public Sub Subtract()
[j2:j99] = [h2:h99-d2:d99]
End Sub
If you like how that works, I'm happy to embellish it so that it is not hard-coded for 98 rows only. Let me know.
UPDATE
Here is a version that will deal with any number of rows. It keys off of column D. So if there are 567 numbers in column D, then you will get 567 corresponding (subtracted) results in column J.
This assumes that the data start in row 2, and that there are no blank cells until the numbers in column D end.
If you are going to call this from the Macro Dialog then you should keep it Public. If on the other hand you are going to call it from another procedure in the same module, then you can make it Private.
Here is the enhanced solution:
Public Sub Subtract()
Dim k&
Const F = "iferror(h2:h[]-d2:d[],0)"
k = [count(d:d)]
[j2].Resize(k) = Evaluate(Replace(F, "[]", k + 1))
End Sub
Note that the routine now handles the errors and places a ZERO value in column J when the corresponding value in column H is an error. If you would prefer to have something other than a ZERO (like a blank for instance) when there are errors in column H, just let me know and I'll update to whatever you want.
UPDATE 2
Here is how to handle displaying blanks instead of zeroes:
Public Sub Subtract()
Dim k&
Const F = "iferror(if(h2:h[]-d2:d[]=0,"""",h2:h[]-d2:d[]),0)"
k = [count(d:d)]
[k2].Resize(k) = Evaluate(Replace(F, "[]", k + 1))
End Sub
I have a dated CS degree so I understand the basics of VB but I don't write macros very often and need help solving a particular condition. (...but I understand functions and object oriented programming)
Assume the following:
- Column A contains reference ID's in alphanumeric form, sorted alphabetically.
- Column B contains strings of text, or blanks.
I'm trying to write a macro that automatically removes any extra rows for each unique reference number based on the contents of the "Notes" in column B. The problem is that if column A has multiple instances of a unique ref number, I need to identify which row contains something in column B. There is one catch: it is possible that the reference number has nothing in column B and should be retained.
To explain further, in the following screenshot I would need to:
Keep the yellow highlighted rows
Delete the remaining rows
I tried to show various configurations of how the report might show the data using the brackets on the right and marked in red. Its difficult to explain what I'm trying to do so I figured a picture would show what I need more clearly.
This task is making the report very manual and time consuming.
it's pretty simple
you just go throug the rows and check whether this row needs to be deleted, an earlier row with this id needs to be deleted or nothing should happen.
in my example i mark these rows and delete them in the end.
Sub foo()
Dim rngSelection As Range
Dim startingRow As Integer
Dim endRow As Integer
Dim idColumn As Integer
Dim noteColumn As Integer
Dim idValuableRow As New Dictionary
Dim deleteRows As New Collection
Set rngSelection = Selection
startingRow = rngSelection.Row
endRow = rngSelection.Rows.Count + startingRow - 1
idColumn = rngSelection.Column
noteColumn = idColumn + 1
For i = startingRow To endRow
currentID = Cells(i, idColumn)
If idValuableRow.Exists(currentID) Then
If Trim(idValuableRow(currentID)("note")) <> "" And Trim(Cells(i, noteColumn)) = "" Then
deleteRows.Add i
ElseIf idValuableRow(currentID)("note") = "" And Trim(Cells(i, noteColumn)) <> "" Then
deleteRows.Add idValuableRow(currentID)("row")
idValuableRow(currentID)("row") = i
idValuableRow(currentID)("note") = Cells(i, noteColumn)
End If
Else
Dim arr(2) As Variant
idValuableRow.Add currentID, New Dictionary
idValuableRow(currentID).Add "row", i
idValuableRow(currentID).Add "note", Cells(i, noteColumn)
End If
Next i
deletedRows = 0
For Each element In deleteRows
If element <> "" Then
Rows(element - deletedRows & ":" & element - deletedRows).Select
Selection.Delete Shift:=xlUp
deletedRows = deletedRows + 1
End If
Next element
End Sub
it could look something like this. the only thing you need is to add Microsoft Scripting Runtime in Tools/References
I have the following code
For i = 1 To DepRng.Rows.Count
For j = 1 To DepRng.Columns.Count
DepRng.Cells(i, j) = Application.Sum(KidsRng.Row(i)) //Does not work
Next j
Next i
Although I know is wrong, i have no idea how to get it to store in DepRng.Cells(i, j) the total sum of the whole KidsRng.Row[i] Any help?
The following code works ok.
Perhaps you should compare it with yours:
Sub a()
Dim DepRng As Range
Dim kidsrng As Range
Set DepRng = Range("B1:B2")
Set kidsrng = Range("C1:F2")
For i = 1 To DepRng.Rows.Count
DepRng.Cells(i, 1) = Application.Sum(kidsrng.Rows(i))
Next i
End Sub
Just fill the range C1:F2 with numbers and the totals per row will appear in B1:B2 upon execution of the macro.
Sorted, thanks all for ur help
DepRng.Cells(i, j) = Application.Sum(KidsRng.Rows(i)) //just needed to add the "s" in rows
There may be a better way than this, but this is my solution which depends on the internal Excel formula engine though, it might be sufficient enough for what you're doing... It determines the full address of KidsRng.Row(i), and feeds it into a =SUM() formula string and evaluated by Application.Evaluate.
For i = 1 To DepRng.Rows.Count
For j = 1 To DepRng.Columns.Count
DepRng.Cells(i, j).Value = Application.Evaluate("=SUM(" & KidsRng.Row(i).Address(True, True, xlA1, True) & ")")
Next j
Next i
updated it to work if kidsrng existed in a different sheet/book
updated to use Application.Evaluate