I am trying to produce a VBA function that will hide all columns for which cells D9:CC9 are not equal to "A6" and cells D8:CC8 are not equal to "12." Based on the script below, the system keeps returning an error. I am new to VBA, was hoping someone might be able to assist.
Thanks!
Dim MyCell As Range
Set MyCell = Range("D9:CC9,D8:CC8")
For Each cell In MyCell
If cell.Value <> WorksheetFunction.Index(Range("D9:CC9"),WorksheetFunction.Match(Range("A6")&"12",Range("D9:CC9")&Range("D8:CC8"), 0))
cell.EntireColumn.Hidden = True
End If
Next cell
Most operations are performed quite different using VBA than doing them manually. If you want to work with VBA then should do some research about working with variables and objects. This pages should be of interest.
Variables & Constants, Excel Objects, With Statement & Range Properties (Excel)
I have done some changes to your code, see comments within, and refer to the pages mentioned above.
Sub Rng_HideColumns()
Dim rTrg As Range, rCol As Range
Dim sCllVal As String
Rem Set rTrg = ThisWorkbook.Sheets("Sht(0)").Range("D9:CC9,D8:CC8")
Rem Refers to the worksheet you want to work with instead or using the active worksheet
With ThisWorkbook.Sheets("Sht(0)")
Rem Get value to match
sCllVal = .Range("A6").Value2 & 12
Rem Set Range to Search
Set rTrg = .Range("D8:CC9")
For Each rCol In rTrg.Columns
With rCol
If .Cells(2).Value2 & .Cells(1).Value2 = sCllVal Then
.EntireColumn.Hidden = 1
Else
.EntireColumn.Hidden = 0
End If: End With: Next: End With
End Sub
Related
This question already has answers here:
Delete Column Loop VBA
(2 answers)
Closed 3 years ago.
I have a macro where I search for text in a row and if a column does not have my specified text it is deleted. Here is my code:
Private Sub Test()
Dim lColumn As Long
lColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
Dim i As Long
Dim myCell As Range
Dim myRange As Range
Set myRange = Worksheets("2019").Range(Cells(2, 1), Cells(2, lColumn))
For Each myCell In myRange
If Not myCell Like "*($'000s)*" And Not myCell Like "*Stmt Entry*" And Not myCell Like "*TCF*" And_
Not myCell Like "*Subtotal*" And Not myCell Like "*Hold*" Then
myCell.EntireColumn.Select
Selection.Delete
End If
Next
End Sub
My issue is that when I execute the macro it will only delete some of the columns but not the ones towards the end of the range. If I then run the macro again it will successfully delete all the columns I ask it to.
If I switch the macro to- let's say- make the cells bold instead of deleting them it works perfectly every time.
What am I missing?
Many thanks!
Despite everyone saying "just loop backwards" in this & linked posts, that's not what you want to do.
It's going to work, and then your next question will be "how can I speed up this loop".
The real solution is to stop what you're doing, and do things differently. Modifying a collection as you're iterating it is never a good idea.
Start with a helper function that can combine two ranges into one:
Private Function CombineRanges(ByVal source As Range, ByVal toCombine As Range) As Range
If source Is Nothing Then
'note: returns Nothing if toCombine is Nothing
Set CombineRanges = toCombine
Else
Set CombineRanges = Union(source, toCombine)
End If
End Function
Then declare a toDelete range and use this CombineRanges function to build ("select") a Range while you're iterating - note that this loop does not modify any cells anywhere:
Dim sheet As Worksheet
' todo: use sheet's codename instead if '2019' is in ThisWorkbook
Set sheet = ActiveWorkbook.Worksheets("2019")
Dim source As Range
' note: qualified .Cells member calls refer to same sheet as .Range call
Set source = sheet.Range(sheet.Cells(2, 1), sheet.Cells(2, lColumn))
Dim toDelete As Range
Dim cell As Range
For Each cell In source
'note: needed because comparing cell.Value with anything will throw error 13 "type mismatch" if cell contains a worksheet error value.
'alternatively, use cell.Text.
If Not IsError(cell.Value) Then
If Not cell.Value Like "*($'000s)*" _
And Not cell.Value Like "*Stmt Entry*" _
And Not cell.Value Like "*TCF*" _
And Not cell.Value Like "*Subtotal*" _
And Not cell.Value Like "*Hold*" _
Then
Set toDelete = CombineRanges(cell, toDelete)
End If
End If
Next
The last, final step is to delete the .EntireColumn of the toDelete range... if it isn't Nothing at that point:
If Not toDelete Is Nothing Then toDelete.EntireColumn.Delete
I'm trying to update the conditional formatting range for about 30 rows of data on a worksheet. Every month I update the data and I want to run a macro to adjust the ranges to incorporate the new month. I've already done this for my charts by updating the end of the series ranges by looping through the ChartObjects and SeriesCollection.
To do this on conditional formatting, everything I've found requires hardcoding a range (either a cell reference or a named range), e.g.:
With Worksheets(1).Range("e1:e10").FormatConditions(1)
I'd prefer to just loop through the collection of conditional formatting for the worksheet, but I can't find any evidence of this collection existing in the Excel VBA Object Model. Am I missing something here?
This is a little convoluted since there isn't really any great way to loop through formatconditions in a sheet. But, you can loop through specialcells and then loop through their formatconditions and dig in from there:
Sub test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim rngCell As Range
Dim lng As Long
For Each rngCell In ws.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells
For lng = 1 To rngCell.FormatConditions.Count
On Error Resume Next
Debug.Print rngCell.FormatConditions(lng).Formula1, rngCell.FormatConditions(lng).AppliesTo.Address
Next lng
Next rngCell
End Sub
I poached the specialcells() idea from Dick Kusleika's excellent post on this very subject at dailydoseofexcel.com blog.
You can use code as below: Here Based on condition Highlighted the row in yellow color. You can use your formatting
LastColumnARows = WB_Source.Sheets(SheetName.Name).range("A" & Rows.Count).End(xlUp).Row
With WB_Source.Sheets(SheetName.Name)
For i = 2 To LastColumnARows
If .range("A" & i).Value > [Condition] Then
With .range("A" & i & ":E" & i)
.Interior.Color = vbYellow
.Font.Color = vbBlack
End With
End If
Next i
End With
When debugging or Quality Checking an Excel report at work I have found that the problem was because of text being hard coded inside a formula. I have heard this as being a Constant and Formula mixed cell.
Here are examples of what I see.
Constant =100
Constant =Facility
Formula cell =INDIRECT(ADDRESS(5,MATCH($A7&$B7&C$2,Data!$4:$4,0),,,$A$2))
Mixed cell =INDIRECT("Data!"&ADDRESS(5,MATCH($A7&$B7&C$2,Data!$4:$4,0)))
"Data!" is the Constant in the mixed cell, in this case the sheet name. If that sheet name ever changed, the formula would break. I have found and am using two conditional formats to highlight cells that are Constants and those that are formulas using this "Identify formulas using Conditional Formatting". I need to come up with a way to format those cells which contain these Constants inside of formulas.
I have found this question and tried using =IF(COUNT(SEARCH(CHAR(34),A1,1)),TRUE,FALSE) and FIND() to see if I could check if a cell had double quotes inside of it, but the SEARCH() returns FALSE since it is looking at the cells value and not it's contents. It returns TRUE if the cell contains "Constant" but if it is a formula it returns FALSE, such as if the cell contains ="Constant".
How can I find Constants inside formulas across a whole worksheet or workbook?
EDIT*
Thanks to Sidd's code below I have made a function in a module I can use in conditional formatting to at least highlight cells that contain quotes inside the cells.
Function FormulaHasQuotes(aCell)
If InStr(1, aCell.Formula, """") Then
FormulaHasQuotes = True
Else
FormulaHasQuotes = False
End If
End Function
Let's say your sheet looks like this.
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim aCell As Range, FRange As Range
'~~> Set this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find all the cells which have formula
On Error Resume Next
Set FRange = .Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not FRange Is Nothing Then
'~~> Check for " in the cell's formula
For Each aCell In FRange
If InStr(1, aCell.Formula, """") Then
Debug.Print "Cell " & aCell.Address; " has a constant"
End If
Next
End If
End With
End Sub
When you run the above code, you get this output
Cell $A$2 has a constant
Cell $A$5 has a constant
Note: I have shown you how to do it for a sheet, i am sure you can replicate it for all sheets in a workbook?
Only very lightly tested...
For example will not handle "string" constants which contain embedded "
Sub Tester()
'add reference to "Microsoft VBScript Regular Expressions 5.5"
Dim regxnum As New RegExp, regexpchar As New RegExp
Dim matches As MatchCollection, m As Match
Dim rngF As Range, c As Range
On Error Resume Next
Set rngF = ActiveSheet.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0
If Not rngF Is Nothing Then
regxnum.Pattern = "[^A-Z$](-?\d{1,}\.?\d{0,})"
regxnum.Global = True
regexpchar.Pattern = "(""[^""]{0,}"")"
regexpchar.Global = True
For Each c In rngF.Cells
Debug.Print c.Formula
Set matches = regxnum.Execute(c.Formula)
For Each m In matches
Debug.Print c.Parent.Name, c.Address(), m.SubMatches(0)
Next m
Set matches = regexpchar.Execute(c.Formula)
For Each m In matches
Debug.Print c.Parent.Name, c.Address(), m.SubMatches(0)
Next m
Next c
End If
End Sub
I have two worksheets, I want to use a value in sheet to_approve to lookup against column A in sheet submitted, then identify the cell reference so I can paste a value in the cell adjacent (column B).
I have used the following to identify the cell reference, but I don't know how to use it in VBA code.
=ADDRESS(MATCH(To_Approve!D19,Submitted!A:A,0),1,4,1,"submitted")
While many functions can be used in VBA using Application.WorksheetFunction.FunctionName ADDRESS is not one of these (MATCH is)
But even it it was available I would still use a Find method as below as it:
gives you the ability to match whole or part strings, case sensitive or not
returns a range object to work with if the value is found
readily handles a no match
you can control the point in the range being search as to where the search starts
multiple matches can be returned with FindNext
something like
Sub GetCell()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets("submitted")
Set rng1 = ws.Columns("A").Find(Sheets("To_Approve").[d19], , xlValues, xlWhole)
If Not rng1 Is Nothing Then
MsgBox rng1.Address & " in sheet " & ws.Name
Else
MsgBox "not found", vbCritical
End If
End Sub
This example should give you an idea of how to find a corresponding value on another sheet and place a second value in the the column to the left. When using VBA, it is not necessary to select cells and then paste; you can directly enter a value into a range (cell) object.
Sub TransferValue()
Dim rngSearch As Range
Dim rngFind As Range
Dim dValue As Double
' initialization
Set rngSearch = Worksheets("to_approve").Range("D19")
dValue = Date
' find the match & insert value
Set rngFind = Worksheets("submitted").Columns(1).Find(What:=rngSearch.Value)
If Not rngFind Is Nothing Then
rngFind.Offset(ColumnOffset:=1).Value = dValue
End If
End Sub
(Note: dValue is a placeholder for whatever value you want to enter.)
Goal: Efficiently show/hide rows based on the data in the row.
Create a helper column that determines whether or not
a row should be hidden.
Have the formula in the helper
column return an error or a number.
Hide the helper column and write
code to execute the hiding/showing.
Question: Which one of the following methods would you expect to be faster? Column B is the helper column and will always be contiguous.
Sub SetRowVisibility1()
Dim rowsToCheck As Range
With ActiveSheet
Set rowsToCheck = .Range(Range("B7"), Range("B7").End(xlDown))
End With
Dim needToShow As Range, needToShow_Showing As Range
Dim needToHide As Range, needToHide_Showing As Range
Set needToShow = rowsToCheck.SpecialCells(xlCellTypeFormulas, xlNumbers)
Set needToHide = rowsToCheck.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error Resume Next
Set needToShow_Showing = needToShow.Offset(0, 1).SpecialCells(xlCellTypeVisible)
Set needToHide_Showing = needToHide.Offset(0, 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not needToHide_Showing Is Nothing Then
needToHide_Showing.EntireRow.Hidden = True
End If
If Not needToShow Is Nothing Then
If needToShow.Count <> needToShow_Showing.Count Then
needToShow.EntireRow.Hidden = False
End If
End If
End Sub
Sub SetRowVisibility2()
Dim rowsToCheck As Range
With ActiveSheet
Set rowsToCheck = .Range(Range("B7"), Range("B7").End(xlDown))
End With
Dim needToShow As Range, needToHide As Range
Dim cell As Range
For Each cell In rowsToCheck
If IsError(cell.Value) And (cell.EntireRow.Hidden = False) Then
If needToHide Is Nothing Then
Set needToHide = cell
Else
Set needToHide = Union(needToHide, cell)
End If
End If
If Not IsError(cell.Value) And (cell.EntireRow.Hidden = True) Then
If needToShow Is Nothing Then
Set needToShow = cell
Else
Set needToShow = Union(needToShow, cell)
End If
End If
Next cell
If Not needToHide Is Nothing Then needToHide.EntireRow.Hidden = True
If Not needToShow Is Nothing Then needToShow.EntireRow.Hidden = False
End Sub
there is a different way and that is to use th auto filter feature - after all VBA has an A in it - use the features of the application wherever possible
so this bit of code is pretty short and sweet - assumes that the data is a contiguous block in columns a and b and assumes no other error handling in play. the resume next line allows for the filter to be already turned on.
Sub showHideRange()
Dim testrange
testrange = Range("A1").CurrentRegion.Address
On Error Resume Next
testrange.AutoFilter
ActiveSheet.Range(testrange).AutoFilter Field:=2, Criteria1:="show"
End Sub
If you do not wish to show the user what's happening, would it not be better to perform the calculation in VBA itself, rather than in a hidden column? Granted, that would seem to lock you into option 2, which I suspect is the slower option ... most of my VBA experience is in older versions of Excel, so I've not had the pleasure of working with some of the newer features, and the tasks I've done that involved processing rows of data were done row-by-row.
I guess one possible issue with the first sub is that if there is a problem with the worksheet or the values you're using to determine hiding/showing, the process will fail. If you check row-by-row and there is a row that causes problems, you could skip over that row and process the other ones correctly.