I'm struggling with the following: Three columns in a worksheet, in column C, there's a variety of supplier names (supplier 1,2,3,4,5 etc..) and I'd like to use a combination of for..each with if statement to delete entire row if certain conditions are met. So far I've come up with the code below.
The code works as such, the problem is it only deletes a certain number of supplier records in the given range.E.g.if I have 20 records of "Supplier 1" in my table, the code deletes 10 of them and and I have to run the code manually again to delete the rest. Another problem is my range can be dynamic as well, maybe you could advise on this as well. I tried defining my range as the entire C column but this obviously doesn't make sense, long term. (and it didn't solve the problem of having to run the code multiple times anyway)
Sub peters()
Dim rng As Range
Dim cell As Range
Set rng = Sheet2.Range("C1:C37")
For Each cell In rng
If cell.Value = "Supplier 1" Or cell.Value = "Supplier 2" Then
cell.EntireRow.Delete
End If
Next cell
End Sub
To keep the range dynamic you could use:
Set rng = Sheet2.Range("A1").CurrentRegion.Columns(3)
The correctness of the above will depend on how the data fields. CurrentRegion includes all adjacent populated cells.
Related
So I have two worksheets. The first one is "Upsert" and the Second is "Compare".
I will be doing this comparison weekly so row count will differ every time aka number of projects to compare will be different.
Both of these worksheets have a Column C with a project ID (unique). What i want to happen is for the macro to find a project ID in the "Upsert" spreadsheet column C and if it finds that same project ID in Column C of the "Compare" spreadsheet, to then compare the whole rows to make sure everything matches the "Compare" spreadsheet (columns on both sheets are in the same order so hope that helps). If any cell in that row we are comparing does not match, highlight yellow in the "Upsert" spreadsheet. There are 38 columns in each worksheet.
NOT A HUGE PRIORITY AS ABOVE BUT IF ALSO POSSIBLE:
If there are project IDs in the "upsert" spreadsheet that are not found in the "compare" spreadsheet, highlight those. Also if there are project ids found in the "compare" spreadsheet that are not found in the "upsert" spreadsheet, highlight in the "compare" spreadsheet.
Please let me know if there are questions.
This should do the trick. Paste code in a Module and should work as is.
If a Project ID exists on Upsert and NOT on Compare: Project ID will highlight red on Upsert
If a Project ID exists on both sheets, 38 columns will be compared (starting with A and moving outward). If the columns do not match, the cell in question will highlight yellow on Upsert. If your column span increases, you will need to adjust the 38 in the For i loop.
I did not include your last ask (if it exists on Compare and not on Upsert highlight yellow on Compare). You should be able to figure that out using below code and the internets.
Option Explicit
Sub Compare()
Dim Upsert As Worksheet: Set Upsert = ThisWorkbook.Sheets("Upsert")
Dim Compare As Worksheet: Set Compare = ThisWorkbook.Sheets("Compare")
Dim ProjectIDs As Range: Set ProjectIDs = Upsert.Range("K2:K" & Upsert.Range("K" & Upsert.Rows.Count).End(xlUp).Row)
Dim SearchRange As Range: Set SearchRange = Compare.Range("K:K")
Dim Project As Range, Found As Range, i As Long
Application.ScreenUpdating = False
For Each Project In ProjectIDs
Set Found = SearchRange.Find(Project, Lookat:=xlWhole)
If Not Found Is Nothing Then 'If Project ID is found
For i = 1 To 38 'Compare Columns
If Upsert.Cells(Project.Row, i).Value2 <> Compare.Cells(Found.Row, i).Value2 Then
Upsert.Cells(Project.Row, i).Interior.Color = vbYellow
End If
Next i 'Next Column Comparison
Else 'If a project ID is not found
Project.Interior.Color = vbRed
End If
Next Project
Application.ScreenUpdating = True
MsgBox "Please show an attempt next time", vbCritical
End Sub
Run-time: less than a second for 2,000 rows
This could probably be sped up by loading the column values in an array and do array by array comparison (by item). I don't know how many rows you expect to have which will determine the speed of this ultimately. If this is slow for you, I would pursue an array comparison rather a cell by cell comparison, which is what I have provided.
I have a table (Table 1) with a whole bunch of well data (versions, MD, HD, etc.) and I want to create another table (Table 2) that will only show the data for the well I am interested in.
I have it set up where you select the well using a drop down list. Then I want Table 2 to be populated with four values for each of the iterations that show up in Table 1....
I tried using vlookup but was having issues when a well had multiple versions. And I also tried using an advanced filter.
Screenshot of the spreadsheet
Let's solve this using a helper column. First, assume column A will be used to the left of your table, to show the row number which each one of these is found in.
A5 would have the following formula:
=MATCH($C$1,K:K,0)
This shows us the row number that Well1 is first matched at. Then A6 and copied down would have the formula:
=A5+MATCH(B6,OFFSET(K1,A5,0,COUNT(M:M),1),0)
This uses OFFSET to create a new range, starting at the cell immediately below the previous match for Well1, and then uses MATCH to find what row that occurs.
So now, column A will always show the row number to pull data from. The rest is simply using the INDEX function to pull from your desired columns. For example, the data in column C pulls the iteration from column L, and can be pulled through formula like so, in cell C5 and copied to the right / down:
=INDEX(L:L,$A5)
If your data is appropriately normalized, you might be better off with a Pivot Table. This would give you the option of filtering by Well ID.
To use a Advanced filter you will need to create a worksheet event. Place this in the code for the sheet on which you want the data.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2")) Is Nothing Then
Dim dataRng As Range
Dim critRng As Range
Dim CpyToRng As Range
Dim cpytoarr() As Variant
With Worksheets("Sheet1")
Set dataRng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown).End(xlToRight))
End With
With Me
.Range("CC1") = .Cells(1, 1).Value
.Range("CC2") = "'=" & .Cells(2, 1).Value
Set critRng = .Range("CC1:CC2")
Set CpyToRng = .Range(.Cells(6, 1), .Cells(6, 1).End(xlToRight))
End With
Debug.Print dataRng.Address
Debug.Print critRng.Address
Debug.Print CpyToRng.Address
dataRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=critRng, CopyToRange:=CpyToRng, _
Unique:=False
critRng.ClearContents
End If
End Sub
How this works. This assumes the data is on Sheet1 and starts in "A1" with no blanks in column A or the last row:
On Sheet2 set it up like this:
It is important that the header rows on sheet2 are name identical to the headers on sheet1.
Now every time that the value changes in A2 on sheet 2, your drop down, the requisite data will appear below row 6.
I have a rather complicated problem.
I have a log file that when put into excel the column "I" contains event IDs, and the column J contains a custom key that keeps a particular even grouped.
All i want to do is remove any rows that do not contain the value of say 102 in the event id column.
And THEN i need to check the custom key (column J) and remove rows that are duplicates since any duplicates will falsely show other statistics i want.
I have gotten as far as being able to retrieve the values from the columns using com objects and .entirecolumn cell value etc, but I am completely stumped as to how i can piece together a solid way to remove rows. I could not figure out how to get the row for each value.
To give a bit more clarity this is my thought process on what i need to do:
If cell value in Column I does not = 102 Then delete the row that cell contains.
Repeat for all rows in spreadsheet.
And THEN-
Read every cell in column J and remove all rows containing duplicates based on the values in column J.
Save spreadsheet.
Can any kind persons help me?
Additional Info:
Column I holds a string that is an event id number e.g = 1029
Column J holds a string that is a mix of numbers and letters = 1ASER0X3NEX0S
Ellz, I do agree with Macro Man in that your tags are misleading and, more importantly, I did indeed need to know the details of Column J.
However, I got so sick of rude posts today and yours was polite and respectful so I've pasted some code below that will do the trick ... provided Column J can be a string (the details of which you haven't given us ... see what Macro Man's getting at?).
There are many ways to test for duplicates. One is to try and add a unique key to a collection and see if it throws an error. Many wouldn't like that philosophy but it seemed to be okay for you because it also gives you a collection of all the unique (ie remaining) keys in Column J.
Sub Delete102sAndDuplicates()
Dim ws As Worksheet
Dim uniques As Collection
Dim rng As Range
Dim rowPair As Range
Dim iCell As Range
Dim jCell As Range
Dim delRows As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set rng = Intersect(ws.UsedRange, ws.Range("I:J"))
Set uniques = New Collection
For Each rowPair In rng.Rows
Set iCell = rowPair.Cells(, 1)
Set jCell = rowPair.Cells(, 2)
On Error Resume Next
uniques.Add jCell.Value2, jCell.Text
If Err = 457 Or iCell.Value2 = 102 Then
On Error GoTo 0
If delRows Is Nothing Then
Set delRows = rowPair.EntireRow
Else
Set delRows = Union(delRows, rowPair.EntireRow)
End If
End If
Next
If Not delRows is Nothing then
MsgBox delRows.Address(False, False) & " deleted."
delRows.Delete
End If
End Sub
There are a number of ways in which this can be done, and which is best will depend on how frequently you perform this task and whether you want to have it fully automated. Since you've tagged your question with VBA I assume you'll be happy with a VBA-based answer:
Sub removeValues()
Range("I1").Select 'Start at the top of the I column
'We are going to go down the column until we hit an empty row
Do Until IsEmpty(ActiveCell.Value) = True
If ActiveCell.Value <> 102 Then
ActiveCell.EntireRow.Delete 'Then delete the row
Else
ActiveCell.Offset(1).Select 'Select the cell below
End If
Loop
'Now we have removed all non-102 values from the column, let`s remove the duplicates from the J column
Range("A:J").RemoveDuplicates Columns:=10, Header:=xlNo
End Sub
The key line there is Range("A:J").RemoveDuplicates. It will remove rows from the range you specify according to duplicates it finds in the column you specify. In that case, it will remove items from the A-J columns based on duplicates in column 10 (which is J). If your data extends beyond the J column, then you'll need to replace "A:J" with the appropriate range. Note that the Columns value is relative to the index of the first column, so while the J column is 10 when that range starts at A (1), it would be 2 for example if the range were only I:J. Does that make sense?
(Note: Using ActiveCell is not really best practice, but it's the method that most obviously translates to what you were trying to do and as it seems you're new to VBA I thought it would be the easiest to understand).
I need to create a dynamic range between two named cells (the cells and corresponding rows shouldn't be included in the selection). The number of columns is always the same (4), only the number of rows is changing. That's the first step.
Second one is putting several these ranges into a numbered list in another excel list, but that is something I can hopefully figure out myself. Thank you very much.
I might try something like this:
Sub RangeBetween()
Dim rng1 As Range, rng2 As Range
Dim betRange As Range
Set rng1 = Range("A1") 'sample data
Set rng2 = Range("A20")
Set betRange = Range(rng1.Offset(1, 0).Address & ":" & rng2.Offset(-1, 3).Address)
End Sub
This is of course assuming that your named cells are along the same column. If your named cells always spread 4 columns by default, replace the Offset(-1, 3) with Offset(-1, 0).
This code defines a named range with the name "NewNamedRange". The code assumes (and requires) that your bracketing cells are already named ranges, with the names "UpperLeft" and "LowerRight". The offset formulas exclude the bracketing cells from the named range. So if "UpperLeft" is cell D2, and "LowerRight" is cell G22, "NewNamedRange" will be the range "D3:G21". Because the named range definition is a formula, NewNamedRange will change dynamically as the bracketing cell definitions change. Hope this helps.
Sub NamedRange()
ActiveWorkbook.Names.Add _
Name:="NewNamedRange", _
RefersTo:="=OFFSET(UpperLeft,1,0):OFFSET(LowerRight,-1,0)"
End Sub
So I have a range of cells that contains a list of Cell Addresses.
Column B & C show where a block of information starts and ends. Column D states whether it is the start of a combination of tables, the end of the combination, or whether it's a single Table.
So basically I am having some difficulty combining the answers from B & C to form a combined range. So in the picture, Column E shows the start as A170 and the End as A596. (I don't think this is necessary tbh) I need to make a range containing A170:A543, A548:A554, etc. and it needs to be dynamic. So these should create themselves based on the values in Column D. I'm looking to do this in VBA, but if it's easier to do in Excel Formulas, that's okay too.
Can anyone give me some hints how to accomplish this? My brain is currently mush.
You can create a small User Defined Function (aka UDF) that will stitch together the non-contiguous cell ranges from textual representations of their respective addresses. This can return a range for a native worksheet function that uses a cell range like the SUM function or COUNTA function (to use two very simple examples).
Function makeNoncontiguousRange(startRNGs As Range)
Dim rng As Range, rUNION As Range
For Each rng In startRNGs
If rUNION Is Nothing Then
Set rUNION = Range(rng.Value2, rng.Offset(0, 1).Value2)
Else
Set rUNION = Union(rUNION, Range(rng.Value2, rng.Offset(0, 1).Value2))
End If
Next rng
'Debug.Print rUNION.Address
Set makeNoncontiguousRange = rUNION
End Function
The function could be used on a worksheet like,
=SUM(makeNoncontiguousRange(B2:B4))
In your data sample this would be like writing,
=SUM($A$170:$A$543,$A$548:$A$554,$A$558:$A$566)
Note that I am only passing in the start of the range in column B and gaining the end range with .Offset. If you need to expand the functionality to pass in the end range then you will need to check if both the start and end ranges are the same size.