I want to delete a specific value in a column with vba.
Here is my code for now. But of course it is not working.
vstd = Range("J6").Offset(l - 1, 0).Value
For Each Rng2 In Range("F6:F2555")
If Rng2.Value = vstd Then
Rng2.ClearContents
End If
Next
Is this close to what you're looking for?
Sub Macro2()
Dim vSpecificVal As Variant
vSpecificVal = Range("J6").Offset(l - 1, 0).Value
Call Range("F6:F2555").Replace(vSpecificVal, "")
End Sub
Please let us know thanks
here's an AutoFilter() approach:
Option Explicit
Sub ClearColumn()
Dim l As Long
l = 1 '<--| initializing 'l' variable value
With Range("F5:F2555") '<--| reference your range
.AutoFilter Field:=1, Criteria1:=Range("J6").Offset(l - 1, 0).Value '<--| filter on value in cell offsetted "l-1" rows from J6
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible).ClearContents '<--| if any filtered cell found clear their contents
End With
ActiveSheet.AutoFilterMode = False
End Sub
be sure that you initialize l values so as not to have Range("J6").Offset(l - 1, 0) reference an invalid Range (i.e. l must be less than 6)
Related
In the continuing saga of my data analysis (First Question), I want to delete all the rows whose departments (Field 7) are not 101, 102 or 103 (the names have been changed to protect the innocent). There are about a hundred departments in the data, so using Criteria1:=Array("104", "105", "106", etc is impractical.
I would like to do something like this:
myrange.AutoFilter Field:=7, Criteria1:="<>101", Operator:=xlOr, _
Criteria2:="<>102", Operator:=xlOr, Criteria3:="<>103"
but Excel doesn't recognize more than 2 Criteria. I could add a helper column, and have the macro run through each line (if 101, 102, or 103, then value=Yes), filter out the yeses, and delete all that remain, but I'm saving that as a last resort.
Is there a way to Autofilter Criteria1 to be Not Equal To an array? Something like:
myrange.AutoFilter Field:=7, Criteria1:="<>" & Array("101", "102", "103")
Remember the goal is to delete the non-matching rows; AutoFilter is only one tool to help achieve the goal. If AutoFilter does not meet your needs, pick another method. Consider:
Sub AllBut()
Dim rTable As Range, r As Range
Dim rDelete As Range
Set rTable = Selection
Set rDelete = Nothing
For Each r In rTable.Columns(7).Cells
v = r.Value
If v <> "101" And v <> "102" And v <> "103" Then
If rDelete Is Nothing Then
Set rDelete = r
Else
Set rDelete = Union(r, rDelete)
End If
End If
Next
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub
Here we select the block of data to be processed (not including the header row). The macro sweeps down column #7 of that block and deletes any row that does not match the criteria.
All that will remain are the 101's, the 102's, and the 103's.
Since this was about the AutoFilter method, I'll offer up this method involving using a Scripting.Dictionary object to mimic the procedure that would be used if this was manually performed on the worksheet.
On the worksheet, the user would apply an AutoFilter then use column G's drop down to 'turn off' the 101, 102 and 103 values. What remained would be be deleted. In VBA, we can grab all of column G and populate a dictionary object with the values that are not 101, 102 or 103 and use that as the criteria for the filter operation.
Sub filterNotThree()
Dim d As Long, dDELs As Object, vVALs As Variant
Set dDELs = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet6")
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
'grab all of column G (minus the header) into a variant array
vVALs = .Resize(.Rows.Count - 1, 1).Offset(1, 6).Value2
'populate the dictionary object with the values that are NOT 101, 102, or 103
For d = LBound(vVALs, 1) To UBound(vVALs, 1)
Select Case vVALs(d, 1)
Case 101, 102, 103
'do not add
Case Else
'not a match, add it to the delete list
'the AutoFilter criteria needs to be text
' so we set the Keys as text and the Items as numbers
dDELs.Item(CStr(vVALs(d, 1))) = vVALs(d, 1)
End Select
Next d
'check to make sure there is something to filter on
If CBool(dDELs.Count) Then
'filter on the dictionary keys
.AutoFilter field:=7, Criteria1:=dDELs.keys, Operator:=xlFilterValues
'delete the visible rows (there has to be some)
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).EntireRow.Delete
End If
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
dDELs.RemoveAll: Set dDELs = Nothing
End Sub
Data before filterNotThree sub procedure
Data after filterNotThree sub procedure
I was doing something similar but for two fields and this syntax worked for me:
myrange.AutoFilter Field:=7, Criteria1:="<>101", Operator:=xlAnd, Criteria2:="<>102", Operator:=xlAnd
Hope it helps.
I know this is late but if you need more than 2 criteria, you have to use an array.
myrange.AutoFilter Field:=7, Criteria1:=Array("<>101", "<>102", "<>103"), Operator:=xlFilterValues
I can't finish the last part of my code if anyone could assist. When a cell is not a number I need it to delete the data in the cell.
Try the code below:
Sub ValueOnly()
Dim x As Integer
Application.ScreenUpdating = False
With Sheets("Consolidated Data")
For x = 1 To 3107
With .Cells(10 + x, 9)
If Not IsNumeric(.Value) Then .ClearContents
End With
With .Cells(10 + x, 10)
If Not IsNumeric(.Value) Then .ClearContents
End With
Next x
End With
End Sub
since IsNumeric() can have issues, you may want to try a SpecialCells() approach, which is a little trickier:
Option Explicit
Sub ValueOnly()
Dim numericRng As Range, lastNumericRng As Range, lastRng As Range
Dim iArea As Long
With Sheets("Consolidated Data").Range("I11:I3317").SpecialCells(xlCellTypeConstants) '<--| consider only your wanted range "not blank" values
Set numericRng = .SpecialCells(xlCellTypeConstants, xlNumbers) '<--| store "numeric" values
If Intersect(.Cells(1), numericRng) Is Nothing Then '<--| check if first value is not numeric
.Parent.Range(.Cells(1), numericRng(1).Offset(-1)).ClearContents
End If
With numericRng
For iArea = 2 To .areas.Count '<--| clear all not numeric values between numeric ones
.Parent.Range(.areas(iArea - 1).Offset(.areas(iArea - 1).Count).Resize(1), _
.areas(iArea).Resize(1).Offset(-1)).ClearContents
Next
End With
Set lastRng = .areas(.areas.Count).Cells(.areas(.areas.Count).Count)
If Intersect(lastRng, numericRng) Is Nothing Then '<--| check if last value is not numeric
With numericRng
Set lastNumericRng = .areas(.areas.Count).Offset(.areas(.areas.Count).Count).Resize(1)
End With
.Parent.Range(lastNumericRng, lastRng).ClearContents
End If
End With
End Sub
I'm trying to setup a VBA code that loops through each cell in column M and returns the value of Column L if the cell contains a number, and goes through an index/match function if Column L doesn't contain a number. Then if the index/match doesn't find what it's looking for, it goes through another vlookup. I'm having trouble with the syntax of the third part of this (the vlookup at the end). I'm not sure if it should be another Else statement or an if statement or an ISerror or something different entirely. Right now I have it set up as the second if/else. I'm also wondering if I will have problems due to the fact that the index/match function has text as the input and should return a number. Any suggestions/advice on this is much appreciated. Below is what I have so far.
Sub Ranking_2()
Dim cell As Range, rng As Range
Set rng = Range("L2:L120")
For Each cell In rng
If WorksheetFunction.IsNumber(cell.Value) Then
cell.Offset(0, 1).Value = cell.Value
Else: cell.Offset(0, 1).Value = WorksheetFunction.Index(ThisWorkbook.Sheets(1).Range("K:K"), WorksheetFunction.Match(cell.Offset(0, 1) & cell.Offset(0, 5), ThisWorkbook.Sheets(1).Range("A:A") & ThisWorkbook.Sheets(1).Range("H:H"), 0))
If:cell.Offset(0,1).Value= WorksheetFunction.IsError(
Else: cell.Offset(0, 1).Value = WorksheetFunction.VLookup(cell.Offset(0, -11), ThisWorkbook.Sheets(2).Range("A1:D136"), 3, 0)
End If
Next
End Sub
you may want to adopt these changes to your code
Option Explicit
Sub Ranking_2()
Dim cell As Range
Dim lookUp1Sht As Worksheet
Dim lookUp2Rng As Range
Dim val1 As Variant
Set lookUp1Sht = ThisWorkbook.Worksheets("LookUp1Sht") '<--| set the worksheet you're making the first lookup
Set lookUp2Rng = ThisWorkbook.Worksheets("LookUp2Sht").Range("A1:C136") '<--| since you're this range returning column "C" value it suffices limiting it to column "C"
For Each cell In Range("L2:L120").SpecialCells(xlCellTypeConstants) '<--| limit looping through wanted range not blank cells only
With cell '<--| reference current cell
Select Case True
Case IsNumeric(.Value) '<--| if current cell value can be evaluated as "number"...
.Offset(0, 1).Value = CDbl(.Value)
Case Not IsError(LookUp1(lookUp1Sht, .Offset(0, 1).Value, .Offset(0, 5).Value, val1)) '<-- if "first" lookup doesn't return an "error"...
.Offset(0, 1).Value = val1 '<--| then write the 3rd argument passed from LookUp1() function
Case Else '<-- if all preceeding "cases" failed...
.Offset(0, 1).Value = Application.VLookup(.Offset(0, -11), lookUp2Rng, 3, 0) '<-- write "second" lookup return value
End Select
End With
Next
End Sub
Function LookUp1(sht As Worksheet, val1 As Variant, val2 As Variant, val As Variant) As Variant
Dim f As Range
Dim firstAddress As String
With sht '<--| reference passed worksheet
Set f = .Range("A:A").Find(what:=val1, LookIn:=xlValues, lookat:=xlWhole) '<-- look for first passed value in its column "A"
If Not f Is Nothing Then '<--| if found...
firstAddress = f.Address '<--| store found cell address to stop subsequent FindNext() loop upon wrapping back to it
Do '<--| loop
If f.Offset(, 7).Value = val2 Then '<--| if corresponding value in column "H" matches val2...
val = .Cells(f.row, "K") '<-- set 3rd argument to value in column "K" corresponding to the "double" match
Exit Function '<--| exit function
End If
Set f = .Range("A:A").FindNext(f) '<-- go on looking for val1 in column "A"
Loop While f.Address <> firstAddress '<-- stop looping upon wrapping back on first cell found
End If
End With
LookUp1 = CVErr(xlErrValue) '<-- if no "double" match occurred then return "#VALUE!" error
End Function
please note that:
change "LookUp1Sht" and "LookUp2Sht" to your actual worksheets names
Match and LookUp Application functions handle possible errors without halting the macro and simply returning the error value
This I only used in .Offset(0, 1).Value = Application.VLookup(.Offset(0, -11)..., so that if the "last chance lookup" ever returned an error you would have it written in your .Offset(0,1) cell
use SpecialCells() method to return a filtered group of the range you call it on: for instance using xlCellTypeConstants as its Type parameter you'd get back not empty cell only
use IsNumeric() function instead of [WorksheetFunction.IsNumber()[(https://msdn.microsoft.com/en-us/library/office/ff840818(v=office.15).aspx) since the former will recognize string "5" as a number, while the latter would not
I'm new to VBA and English isn't my native language so here goes.
I want to conditional format rows/ range (giving them green-colored background) if cell C in that row have duplicate value in column C and also if there's a cell in column O that equals 0, but if the cell in column C has no similar value, don't apply the conditional format to that cell (eventhough cells in column O has the value of 0).
Note: Cells that have same values in column C will always be above and below each other, for example it's possible that C1=C2=C3 but not C1<>C2, C1=C3
I know I'm not explaining it clearly, so please just let me know if you want more information.
Update (more information): I may have 3 or more rows with same C column value above and below each other, and the zero value in column O will always be the bottom row.
Example:
If C1=C2=C3=C4=C5 and O5=0 , Rows 1 2 3 4 5 become green colored.
I prefer using conditional format even if it needs vba code so I dont have to run it everytime there's new 0 in column O.
I've used this code but it doesn't work (obviously), but maybe it's a little different with my question because the real data is more complicated than what I illustrated. My data table starts at 4th row (header on 3rd). This code only formats 1 row (above the row that has zero column O value) and what I need is all rows with same column C value are formatted. Please keep in mind that I'm a newbie in vba :(
With Range("A4:r8000").FormatConditions.Add( _
Type:=xlExpression, _
Formula1:="=AND($C4=$C5,$O5=0,$F4<>0)")
.Interior.Color = 13551615
.Font.Color = -16383844
End With
Try this as the formula for the CFR,
=and(countif(c:c, c1)>1, o1=0, len(o1))
'alternate for part that I am not sure I understand
=and(countif(c$1:c1, c1)>1, o1=0, len(o1))
This will go through and highlight duplicate cells if any of the duplicate cells' rows have '0' in column O. I am still working on a way that will make this auto update whenever a change happens in Column O, but can't quite figure that out. Will update when I do.
Sub ConditionalFormatSE()
Application.ScreenUpdating = False
Dim lastRow As Long
Dim myCell As Range
Dim colCVals As Range
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Set colCVals = Range("C1", "C" & lastRow)
colCVals.clearformats
For Each myCell In colCVals
If Cells(myCell.Row, 15).Value = "0" Then
If WorksheetFunction.CountIf(colCVals, myCell.Value) > 1 Then
Set c = colCVals.Find(myCell.Value)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.color = RGB(198, 239, 206)
c.Font.color = RGB(0, 97, 0)
Set c = colCVals.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
End If
Next myCell
Set colCVals = Nothing
Set myCell = Nothing
Set c = Nothing
Application.ScreenUpdating = True
End Sub
As for making it run automatically, put this in: VBAProject([workbookname].xlsm)->Microsoft Excel Objects->Sheet1([sheetname]) and it should run whenever a value in column 'O' is changed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Columns(15)
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call ConditionalFormatSE
End If
Set KeyCells = Nothing
End Sub
If cells with same values are always grouped (one below the other), following code might do what you want.
Sub Test()
Dim lLastRow As Long
Dim i As Integer
lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To lLastRow
If ((Worksheets("Sheet1").Cells(i + 1, 3).Value = Worksheets("Sheet1").Cells(i, 3).Value) And (Worksheets("Sheet1").Cells(i, 15).Value = "0")) Then
Worksheets("Sheet1").Cells(i, 3).Interior.Color = vbGreen
End If
Next i
End Sub
I am trying to select the first visible cell directly beneath the header of a filtered column. The code I am getting is as below, but I have to problems with this code. First, the first line of code is using the current active range of the file. It is highly likely that this file will change and this range will not be the same. How can I make it work for any file I would use it on? Second, if I use a totally different file with the same column format, the first visible cell under Column J could be J210. How can I make this work for any array of variables?
Sub Macro16()
'
' Macro16 Macro
'
'
ActiveSheet.Range("$A$1:$R$58418").AutoFilter Field:=12, Criteria1:= _
"Sheets"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[1],3)"
Selection.FillDown
End Sub
Sub FirstVisibleCell()
With Worksheets("You Sheet Name").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
End Sub
Untested but:
Sub Macro16()
With ActiveSheet.Range("A1").CurrentRegion
.AutoFilter field:=12, Criteria1:="Sheets"
If .Columns(1).SpecialCells(xlCellTypeVisible).count > 1 Then
With .Columns(10)
.Resize(.rows.count - 1).offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RIGHT(RC[1],3)"
End With
End If
End With
End Sub
I prefer non-destructive methods of determining whether there are visible cells to work with after a filtering operation. Since you are filling in column J with a formula, there is no guarantee that column J contains any values tat can be counted with the worksheet's SUBTOTAL function (SUBTOTAL does not count rows hidden by a filter) but the formula you are planning to populate into column J references column K so there must be something there.
Sub Macro16()
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
.Columns(12).AutoFilter Field:=1, Criteria1:="Sheets"
With .Resize(.Rows.Count - 1, 1).Offset(1, 9)
If CBool(Application.Subtotal(103, .Offset(0, 1))) Then
.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RIGHT(RC[1],3)"
End If
End With
.Columns(12).AutoFilter Field:=1
End With
End With
End Sub
Something like this might work...
Sub Macro16()
Dim ARow As Long, JRow As Long, ws1 As Worksheet
ws1 = Sheets("NAME OF SHEET WITH DATA")
ARow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
ws1.Range("$A$1:$R$" & ARow).AutoFilter Field:=12, Criteria1:="Sheets"
JRow = ws1.Range("J" & ws1.Rows.Count).End(xlUp).Row + 1
ws1.Range("J" & JRow).FormulaR1C1 = "=RIGHT(RC[1],3)"
ws1.Range("J" & JRow).FillDown
End Sub