Manipulating Excel spreadsheet, removing rows based on values in a column and then removing more rows based on values in another column - vba

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).

Related

Comparing two excelsheets for uncommon cells based on common 'id' field(Column C)

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.

How to delete unselected columns from range

I am new to VBA and am trying to delete unwanted columns loaded from a .csv file. I am importing a large amount of data but then I ask the user what columns they want to keep going by "ID num.". There are a lot of columns with different ID no. and I want to ask the user what they want to keep and delete the rest.
The problem is I need to delete all the other columns the user didn't want but I still need to keep the first 6 columns and the last two columns as that is different information.
Here is what I have so far:
Sub Select()
'the below will take the users inputs
UserValue = InputBox("Give the ID no. to keep seperating with a comma e.g"12,13,14")
'the below will pass the user inputs to the example to split the values
Call Example(UserValue)
End Sub
Sub Example(UserValue)
TestColArray() = Split(UserValue, ",")
For Each TestCol In TestColArray()
' keep all the columns user wants the delete the rest except the first 6 columns and last 2
Next TestCol
End Sub
That is what I have so far, it is not much but the user could put in a lot of columns with different ID number in the input box the way the Excel sheet is laid out all the ID no.s are in row 2 and the first 6 and last 2 columns are blank of row 2 since the ID no. does not apply. I hope that helps.
try this (commented) code:
Option Explicit '<--| use this statament: at the cost of having to declare all used variable, your code will be much easier to debug and maintainable
Sub MySelect()
Dim UserValue As String
'the below will take the users inputs
UserValue = Application.InputBox("Give the ID no. to keep seperating with a comma e.g: ""12,13,14""", Type:=2) '<--| use Type:=2 to force a string input
'the below will pass the user inputs to the example to split the values
Example UserValue '<--| syntax 'Call Example(UserValue)' is old
End Sub
Sub Example(UserValue As String)
Dim TestCol As Variant
Dim cellsToKeep As String
Dim firstIDRng As Range, lastIDRng As Range, IDRng As Range, f As Range
Set firstIDRng = Range("A2").End(xlToRight) '<-- first ID cell
Set lastIDRng = Cells(2, Columns.Count).End(xlToLeft) '<-- last ID cell
Set IDRng = Range(firstIDRng, lastIDRng) '<--| IDs range
cellsToKeep = firstIDRng.Offset(, -6).Resize(, 6).Address(False, False) & "," '<--| initialize cells-to-keep addresses list with the first six blank cells at the left of first ID
For Each TestCol In Split(Replace(UserValue, " ", ""), ",") '<--| loop through passed ID's
Set f = IDRng.Find(what:=TestCol, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| search for the current passed IDs range
If Not f Is Nothing Then cellsToKeep = cellsToKeep & f.Address(False, False) & "," '<--| if the current ID is found then update cells-to-keep addresses list
Next TestCol
cellsToKeep = cellsToKeep & lastIDRng.Offset(, 1).Resize(, 2).Address(False, False) '<--| finish cells-to-keep addresses list with the firts two blank cells at the right of last ID
Range(cellsToKeep).EntireColumn.Hidden = True '<-- hide columns-to-keep
ActiveSheet.UsedRange.EntireColumn.SpecialCells(xlCellTypeVisible).EntireColumn.Delete '<--| delete only visible rows
ActiveSheet.UsedRange.EntireColumn.Hidden = False '<-- unhide columns
End Sub
it's assumed to be working with currently active worksheet
A simple google search produces this. On the first page of results too. Perhaps this will suit your needs.
If the data set that needs to be deleted is really large (larger than the ranges you want to keep too.) Then perhaps only select the columns you want to have whilst you import the csv? This stackoverflow question shows how to import specific columns.
EDIT:
So from what I believe the OP is stating as the problem, there is a large csv file that is being imported into excel. After importing there is alot of redundant columns that should be deleted. My first thought would be to only import the needed data (columns) in the first place. This is possible via VBA by using the .TextToColumns method with the FieldInfo argument. As stated above, the stackoverflow question linked above provides a means of doing so.
If the selective importing is not an option, and you are still keen on making an inverse of the user selection. One option would be to create 2 ranges (one being the user selected Ranges and the second being the entire sheet), you could perform an intersect check between the two ranges and delete the range if there is no intersection present (ie. delete any cell that is not part of the users selection). This method is provided by the first link I supplied and is quite straight forward.

Best way to return data from multiple columns into one row?

I have a sheet with just order numbers and another with order numbers and all of the data associated with those order numbers. I want to match the order numbers and transfer all of the available data into the other sheet. I've been trying to use loops and VLOOKUP but I'm having problems (plus I have 116 columns I want to transfer data from so my vlookup expression doesn't look very nice). Any advice would be appreciated!
this is what I have so far and I'm getting an object error.
I don't think it's the right way to go about it in general though.
Dim LookUpRange As Range
Dim row As Range
Set LookUpRange = Worksheets("batches").Range("B4:B1384")
Set row = Worksheets("batches").Range("C:DL")
For Each row In LookUpRange
row.Select
Selection.FormulaArray ="=VLOOKUP(RC[-1],OrderLvl!RC[-1]:R[1380]C[113],{2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,207,108,109,110,111,112,113,114,115},FALSE)"
Next row
End Sub
Please consider this VBA script to resolve your inquiry:
Sub LookupOuput()
Dim OrderNumberColumn As Range
Set OrderNumberColumn = Worksheets("batches").Range("B2:B1384")
Dim LookUpRange As Range
Set LookUpRange = Worksheets("OrderLvl").Range("C:DL")
Dim cell As Range
Dim FindResult As Range
For Each cell In OrderNumberColumn
If Not cell.Value2 = Empty Then
Set FindResult = LookUpRange.Find(what:=cell.Value2)
If Not FindResult Is Nothing Then
cell.Range("A1:DJ1").Value2 = LookUpRange.Rows(FindResult.row).Value2
End If
End If
Next cell
End Sub
Basically searches for each Order Number in the first sheet on the second sheet. This outputs (if search term exists) the cell that that string is found which we later refer to its row number to output the whole row to the first sheet. Cheers,
A regular VLOOKUP may be able to give you what you need, if you use a small trick...
Insert a row above the data table, and put sequential numbers in
each cell of that row. (ie, A1 = 1, B1 = 2, C1 = 3, etc...)
Do the same thing on your blank table.
Assuming that your first order number is in cell A2, put the following formula into B2: =VLOOKUP($A2,[other sheet name]!$A$1:$DZ$5000,B$1,0)
Drag this formula across all 116 columns, then down all however many rows you've got.
You'll need to adjust the ranges, obviously, but make sure that your lookup array starts in column A. (or alternatively, that your numbers start in the same column as the first column in your array.) Adding the numbers along the top allows you to change what column of the array you're referencing, just by dragging the cell formula.

VBA - EXCEL Remove columns except specified range

I was looking for answers however I can't find one so specific.
I am trying to write macro which will be easy to use for people without any programming knowledge.
So we use pricing template where you can see prices for many different countries. I want to create a macro which will copy whole tab and remove unwanted columns depends from for which country it is creating file. (Needed to preserve formulas, I still want to have all the calculation not values).
So first few columns will stay since they are common for all countries, and then all the columns except selected range should be deleted. Ranges are specified in separate tab and will be stored in array.
Example:
Belgium
First Column: CJ
Last Column: CQ
So let's say in first loop first column and last column values are stored, and I want macro remove columns from H to CI and then from CR to HF.
However in next loop first and last will change so delete ranges have to recalculate.
I tried with formulas ASC and CHR but it doesn't work with two letters codes.
Well, if you already know the ranges you want to use, a subroutine like this could remove a range of columns, minus an exception range.
I'm just looping through the columns and checking for an intersection. If there is no intersection between the column being tested and the exception range, we add it to the list of columns to be deleted.
Public Sub RemoveColumnsExcept(removeRange As Range, exceptRange As Range)
Dim deletionRange As Range
Dim columnRange As Range
For Each columnRange In removeRange.Columns
If Intersect(columnRange, exceptRange) Is Nothing Then
If deletionRange Is Nothing Then
Set deletionRange = columnRange
Else
Set deletionRange = Union(deletionRange, columnRange)
End If
End If
Next columnRange
If Not deletionRange Is Nothing Then
deletionRange.Delete xlShiftToLeft
End If
End Sub
Public Sub Test()
RemoveColumnsExcept Sheet1.[B:J], Sheet1.[G:I]
End Sub
You could use named ranges to keep track of the columns you want deleted. That or column headers and a loop looking for some value like country code in a specific row.

Is there a way to check for duplicate values in Excel WITHOUT using the CountIf function?

A lot of the solutions here on SO involve using CountIf to find duplicates. When I have a list of 100,000+ values however, it will often take minutes for CountIf to search for duplicates.
Is there a quicker way to search for duplicates within an Excel column WITHOUT using CountIf?
Thanks!
EDIT #1:
After reading the comments and replies I realize I need to go into greater detail. Let's pretend I'm a birdwatcher, and after I return from a birdwatching trip I input anywhere from 1 to 25 or 50 new birds that I saw on my trip into my "Master List of Birds Seen". This is really a dynamically growing list, and with each addition I want to make sure I'm not duplicating something that already exists in my list.
So, in column A of my file are the names of the birds. Column B-M might contain other attributes of the birds. I want to know if a bird that I just added in column A after my latest birdwatching trip ALREADY exists somewhere ELSE in my list. And, if it does, I would manually merge the data of the 2 entries and throw away some and keep some after careful review. I clearly don't want to have duplicate entries of the same bird in my database.
So, ultimately I want some indication that there is or isn't a duplicate somewhere else, and if there is duplicate please tell me what row to look in (or highlight or color both of the duplicates).
The fastest way that I know of (in case you are using Excel 2007/2010/2011) is to use Data (In Ribbon) | Remove Duplicates to find the total number of duplicates OR to remove duplicates. You might want to move data to a temp sheet before you test this.
The 2nd fastest way is to use Countif. Now Countif can be used in many ways to find duplicates. Here are two main ways.
1) Inserting a New Column next to the data and putting the formula and simply copying it down.
2) Using Countif in Conditional formatting to highlight cells which are duplicates. For more details, please see this link.
suggestions for a macro to find duplicates in a SINGLE column
EDIT:
My Apologies :)
Countif is the 3rd fastest way!
The 2nd fastest way is to use Pivot Tables ;)
What exactly is your main purpose of finding duplicates? Do you want to delete them? Or Do you want to highlight them? Or something else?
FOLLOWUP
Seems like I made a typo in the formula. Yes for large number of rows, CountIf does take minutes as you suggested.
Let me see if I can come up with a VBA code to suit your exact needs.
Sid
You can use VBA - the following function returns a list of unique entries within a list of 100,000 in less than a second. Usage: select a range, type the formula (=getUniqueListFromRange(YourRange)) and validate with CTRL+SHIFT+ENTER.
Public Function getUniqueListFromRange(parRange As Range) As Variant
' Returns a (1 to n,1 to 1) array with all the values without duplicates
Dim i As Long
Dim j As Long
Dim locKey As Variant
Dim locData As Variant
Dim locUniqueDict As Variant
Dim locUniqueList As Variant
On Error GoTo error_handler
locData = Intersect(parRange.Parent.UsedRange, parRange)
Set locUniqueDict = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 1 To UBound(locData, 1)
For j = 1 To UBound(locData, 2)
locKey = UCase(locData(i, j))
If locKey <> "" Then locUniqueDict.Add locKey, locData(i, j)
Next j
Next i
If locUniqueDict.Count > 0 Then
ReDim locUniqueList(1 To locUniqueDict.Count, 1 To 1) As Variant
i = 1
For Each locKey In locUniqueDict
locUniqueList(i, 1) = locUniqueDict(locKey)
i = i + 1
Next
getUniqueListFromRange = locUniqueList
End If
error_handler: 'Empty range
End Function
If using Excel 2007 or later (which is likely from the 100,000+ values) you can choose:
Home Tab | Conditional Formatting > Highlight Cell Rules > Duplicate Values...
Right-click a highlighted cell and filter by selected cell color to show just the duplicates (be aware however this can be slow with conditional formatting).
Alternatively run this code and filter for colored cells which takes only a second on 100,000 cells:
Sub HighlightDupes()
Dim i As Long, dic As Variant, v As Variant
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
i = 1
For Each v In Selection.Value2
If dic.exists(v) Then dic(v) = "" Else dic.Add v, i
i = i + 1
Next v
Selection.Font.Color = 255
For Each v In dic
If dic(v) <> "" Then Selection(dic(v)).Font.Color = 0
Next v
End Sub
Addendum:
To select only duplicate values without code or formulas, i have found this method useful:
Data Tab | Advanced Filter... Filter in Place, Unique Records Only, OK.
Now select the range of unique values and press Alt+; (Goto Special... Visible cells only). With this selection clear the filter and you will see that all unselected cells are duplicates, you can then press Ctrl+9 (Hide Rows) to show just the duplicates. These rows can be copied to another sheet if needed or marked with an "X".
You do not mention what you want to do when you find them. If you merely want to see where they are...
Sub HighLightCells()
ActiveSheet.UsedRange.Cells.FormatConditions.Delete
ActiveSheet.UsedRange.Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=ActiveCell
ActiveSheet.UsedRange.Cells.FormatConditions(1).Interior.ColorIndex = 4
End Sub
Preventing Duplicates with Data Validation
You can use Data Validation to prevent you entering duplicate bird names. See Debra Dalgelish's site here
Handling existing duplicates
My free Duplicate Master addin will let you
Select
Colour
List
Delete
duplicates.
But more importantly it will let you run more complex matching than exact strings, ie
Case Insensitive / Case Sensitive searches (sample below)
Trim/Clean data
Remove all blank spaces (including CHAR(160)) see the " mapgie" and "magpie" example below
Run regular expression matches (for example the sample below replaces s$ with "" to remove plurals)
Match on any combination of columns (ie Column A, all columns, Column A&B etc)
I'm surprised that no one has mentioned the RemoveDuplicates method.
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1
This will simply remove any duplicate entries on the active worksheet in column A. It takes milliseconds to run (tested with 200k rows). Mind you, this will strictly delete all the duplicate entries. Although that isn't how the original question was worded, I do believe that this still serves your purpose.
One simple way of finding unique values is to use the advance filter and filter for unique values only and copy and paste them into other sheet as when the pivot is removed you will get the whole data with the duplicate in them.
Sort the range
and in next column put `=if(a2=a1;1;if(a2=a3;1;0))
"1" will be displayed for duplicates.