I want to hide several columns (that's not close to each other) in 1 line (shown below) in VBA but it doesn't work. What's wrong with it?
Columns("A, C:D").hidden = True
Use Range.EntireColumn.
Range("A:A,C:D").EntireColumn.Hidden = True
This thread is similar, and this answer demonstrates that Union is another option here as well.
Note that .EntireColumn is necessary; omitting it will throw a
Run-time error '1004':
Unable to set the Hidden property of the Range class.
Hide Columns Using Union
The best answer is already posted so here is kind of a cheating one: it is one line, but uses a function (with 'several' lines).
Option Explicit
Sub hideColumns()
CombinedColumns(ActiveSheet, "A,C,H,K:M,O,R:U").Hidden = True
End Sub
Function CombinedColumns( _
ByVal ws As Worksheet, _
ByVal ColumnsList As String, _
Optional ByVal Delimiter As String = ",") _
As Range
Dim Cols() As String: Cols = Split(ColumnsList, Delimiter)
Dim rg As Range
Dim n As Long
For n = 0 To UBound(Cols)
If rg Is Nothing Then
Set rg = ws.Columns(Cols(n))
Else
Set rg = Union(rg, ws.Columns(Cols(n)))
End If
Next n
If Not rg Is Nothing Then
Set CombinedColumns = rg.EntireColumn
End If
End Function
Related
I am very new to VBA, having started programming it yesterday. I am writing a data processing program which requires keeping track of two cells, one on each spreadsheet. The code which reproduces the errors I am experiencing is below. When I call the sub moveCell() in sub Processor(), nothing happens to DIRow and DIColumn, and the code spits out error 1004 at the line indicated. I have tried using DICell = DICell.Offset(), but it returns the same error.
How can I redefine a Range variable to be a different cell?
'<<Main Processor Code>>'
Sub Processor()
Dim PDRow As Integer
Dim PDColumn As Integer
Dim DIRow As Integer
Dim DIColumn As Integer
PDRow = 1
PDColumn = 1
DIRow = 1
DIColumn = 1
Dim PDCell As Range
Dim DICell As Range
Set PDCell = Worksheets("Processed Data").Cells(PDRow, PDColumn)
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn)
Call moveCell(2, 0, "Data Input")
End Sub
'<<Function which moves the cell which defines the range>>'
Sub moveCell(r As Integer, c As Integer, sheet As String)
If sheet = "Processed Data" Then
PDRow = PDRow + r
PDColumn = PDColumn + c
Set PDCell = Worksheets("Data Input").Cells(PDRow, PDColumn)
ElseIf sheet = "Data Input" Then
DIRow = DIRow + r '<<<<<<This line does nothing to DIRow's value
DIColumn = DIColumn + c
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn) '<<<<<<This line causes error 1004
End If
End Sub
As far as I can tell, you could instead use a quick Function instead. There doesn't seem to be any difference in your If statement results in the moveCell() function, except which worksheet you're using.
We can make this simpler by referring to the Range you're passing to moveCell.
Option Explicit ' forces you to declare all variables
Sub something()
Dim PDCell As Range
Set PDCell = Worksheets("Processed Data").Cells(1, 1)
Dim DICell As Range
Set DICell = Worksheets("Data Input").Cells(1, 1)
PDCell.Select ' can remove
Set PDCell = moveCell(2, 0, PDCell, PDCell.Worksheet.Name)
PDCell.Select ' can remove
Worksheets(DICell.Worksheet.Name).Activate ' can remove
DICell.Select ' can remove
Set DICell = moveCell(5, 0, DICell, DICell.Worksheet.Name)
DICell.Select ' can remove
End Sub
Function moveCell(rowsToMove As Long, colsToMove As Long, cel As Range, ws As String) As Range
Set moveCell = Worksheets(ws).Cells(cel.Row + rowsToMove, cel.Column + colsToMove)
End Function
I've included some rows you don't need (which I've marked with a comment afterwards), but that will show you how the routine works. You can step through with F8 to help see it step-by-step.
Edit: Although, you don't need a separate function at all. Just use OFFSET().
Set PDCell = ...whatever originally
Set PDCell = PDCell.Offset([rows],[cols])
I'm trying to figure this out and can't.
I keep getting an error: "Compile error - Argument not optional". I am supplying the arguments and they are set as Optional!
Trying to pass a string and an array to a function and count occurrences of the array strings within the string passed.
Code stops running at the line:
Public Function countTextInText(Optional text As String, Optional toCountARR As Variant) As Integer
with a "Compile error: Argument not optional" message highlighting the Val in the line:
For Each Val In toCountARR
Full code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nameR As Range
Dim colR As Range
Dim TKRcnt As Integer
Dim TKRarr() As Variant
TKRarr = Array("TKR", "THR", "Bipolar")
Dim ORIFcnt As Integer
Dim ORIFarr() As Variant
TKRarr = Array("ORIF", "Ilizarov", "PFN")
Set nameR = Range("P2:P9")
Set colR = Range("B2:B50,G2:G50,L2:L50")
For Each namecell In nameR
For Each entrycell In colR
If entrycell.text = namecell.text Then
TKRcnt = countTextInText(entrycell.Offset(0, 2).text, TKRarr)
ORIFcnt = countTextInText(entrycell.Offset(0, 2).text, TKRarr)
End If
Next entrycell
MsgBox (namecell.text & " TKR count: " & TKRcnt & " ORIF count: " & ORIFcnt)
Next namecell
End Sub
Public Function countTextInText(Optional text As String, Optional toCountARR As Variant) As Integer
Dim cnt As Integer
Dim inStrLoc As Integer
For Each Val In toCountARR
inStrLoc = InStr(1, text, Val)
While inStrLoc <> 0
inStrLoc = InStr(inStrLoc, text, Val)
cnt = cnt + 1
Wend
Next Val
Set countTextInText = cnt
End Function
Val is a VBA function which requires a single, mandatory, argument - therefore the compiler generates the message saying "Argument not optional" if you don't provide that argument. (MSDN documentation of Val)
It is a bad idea to use VBA function names as variable names, so I would recommend you don't use Val as a variable name - use myVal or anything else that VBA hasn't already used.
If you really want to use Val (and you are sure that you won't be needing to access the Val function at all), you can use it as a variable name if you simply declare it as such, e.g.
Dim Val As Variant
You will also have problems with your line saying
Set countTextInText = cnt
as countTextInText has been declared to be an Integer, and Set should only be used when setting a variable to be a reference to an object. So that line should be
countTextInText = cnt
For those coming late to this question because of the question's title, as I did, having received this error while using the .Find method -
In my case, the problem was that the variable I was Seting was not Dimd at top of function.
My Example
Sub MyTest()
Dim tst, rngAll
rngAll = [a1].CurrentRegion
tst = fnFix1Plus1InValues(ByVal rngAll As Range)
End Sub
Public Function fnFix1Plus1InValues(ByVal rngAll As Range) As Boolean
Dim t1, t2, arr, Loc '<=== Needed Loc added here
Set Loc = rngAll.Find(What:="+", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
t1 = Loc.Value
If fnContains(t1, "+") Then
'Do my stuff
End If
Set Loc = rngAll.FindNext(Loc)
Loop
End If
End Function 'fnFix1Plus1InValues
I have recorded an Excel function (Iferror/Vlookup) which I need to modify to inpput variables to make it more dynamic (Allow for columns moving). Below is a brief outline of what I want to do. The First section is the recorded Function and the variables I want to add. The second section is my proposed solution. My problem is I need to drop the function into excel and copy it down over 50,000 rows. So my error handling solution won't work here. Is it possilbe to make the original recorded function dynamic using iferror/Vlookup. Any help appreciated.
Dim Lookup1 As Long
Dim LookupOffset As Long
Dim LRange As Range
Lookup1 = -99
LookupOffset = 28
Set LRange = Column("CU:CV")
With Worksheets("consolidated")
.Cells(2, 99).FormulaR1C1 = _
"=RC[-71]-IFERROR(VLOOKUP(RC[-12],C[-2]:C[-1],2,FALSE),0)"
.Cells(2, 99).Copy Range(.Cells(2, 99), .Cells(glLastRow, 99))
Application.CutCopyMode = False
.Calculate
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Proposed Solution
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Variant
On Error Resume Next
Err.Clear
Res = Application.WorksheetFunction.VLookup(Lookup1 - LookupOffset, LRange, 2, False)
If Err.Number = 0 Then
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Value found by VLookup. Continue normal execution.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Value NOT found by VLookup. Error handling code here.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Try this one:
Sub LookUpMod()
Dim wSht As Worksheet: Set wSht = ThisWorkbook.Sheets("Consolidated")
With wSht
On Error Resume Next
.Cells(2, 99).Formula = "=XCV34-IFERROR(VLOOKUP(XFC34,$I:$J,2,FALSE),0)"
.Range(Cells(2, 99), Cells(glLastRow, 99)).FillDown
.Calculate
On Error GoTo 0
End With
End Sub
Just noticed, though, that you don't have glLastRow instantiated properly. Let us know if this helps.
EDIT:
As per chat with OP:
Function LookUpMod(Str As Variant, Rng As Range, OffsetToRight As Long)
Application.Volatile
LookUpMod = Rng.Cells.Find(What:=Str).Offset(0, OffsetToRight).Value
End Function
A simple flexible lookup is what is needed.
I've got the following:
Private Sub cmdColumnLetter_Click()
Dim colRange As Range
Set colRange = Excel.Application.InputBox( _
Prompt:="Please Select Any Cell In ""Splitter"" Column", _
Title:="Column", _
Default:=fTableRange.Columns(1).Column, Type:=8)
fColNumber = colRange.Column
TxBoxColumnNum = fColNumber
End Sub
If the user hits cancel then Set colRange = fails as it is looking to assign an object to this variable. Do I have to use an On Error structure to defend against this error or is there a more elegant approach?
Different syntax for assigning objects and values is, IMO, one drawback of VBA.
As such, functions as InputBox returning objects or values cause errors.
However, function arguments passing syntax is same.
Exploring this, I purpose and alternative solution, indeed not better then error handling solution:
Function SetObject(v, ByVal ExpectedTypeName As String) As Object
If TypeName(v) = ExpectedTypeName Then Set SetObject = v
End Function
Private Sub cmdColumnLetter_Click()
Dim colRange As Range
Set colRange = SetObject(Excel.Application.InputBox("input", Type:=8), "Range")
If Not colRange Is Nothing Then
Debug.Print "..."
End If
End Sub
SetObject accepts either an object or a value, but always retuns given object if typename matchs expected one or Nothing if doesn't match.
Yes, you will have to OERN
Sub Test()
Dim colRange As Range
Dim fColNumber As Long, TxBoxColumnNum As Long
On Error Resume Next
Set colRange = Excel.Application.InputBox( _
Prompt:="Please Select Any Cell In ""Splitter"" Column", _
Title:="Column", Default:=fTableRange.Columns(1).Column, Type:=8)
On Error GoTo 0
If colRange Is Nothing Then Exit Sub
fColNumber = colRange.Column
TxBoxColumnNum = fColNumber
End Sub
I'm currently trying to trace the dependencies of a complex set of Excel spreadsheets. My ideal end goal would be a tree structure, starting with my first spreadsheet. However, I don't want to include all of the dependencies of the child spreadsheets, just the ones of the cells referenced by the original spreadsheet. For example:
In cell A1 of my first workbook:
somebook.xls!Sheet1!C2
I want to look at cell C2 in sheet 1 of somebook.xls for its (external) dependencies, and then recurse.
At the moment I'm using LinkInfo to get a list of external dependencies, searching using Find, and I'm struggling with vbscript's primitive regex capabilities to try and extract the address out of the cells I find. This is not a brilliant way of doing things.
Does anyone know if Excel will tell you which cells in an external spreadsheet are being referenced? If not, any other tools that might help?
Thanks.
This answer is based off Bill Manville's macro from many years back. The macro still works, but I broke it out into functions allowing for more flexibility and reusability. The main addition by me is the ability to find external dependencies only, and the extension to both precedents and dependents. I also added a call to a custom macro called unhideAll; this was necessary for me as dependencies were not being found in hidden worksheets.
'Module for examining depedencies to/from a sheet from/to other sheets
Option Explicit
Sub showExternalDependents()
Dim deps As Collection
Set deps = findExternalDependents(ActiveCell)
Call showDents(deps, True, "External Dependents: ")
End Sub
Sub showExternalPrecedents()
Dim precs As Collection
Set precs = findExternalPrecedents(ActiveCell)
Call showDents(precs, True, "External Precedents: ")
End Sub
'external determines whether or not to print out the absolute address including workbook & worksheet
Sub showDents(dents As Collection, external As Boolean, header As String)
Dim dent As Variant
Dim stMsg As String
stMsg = ""
For Each dent In dents
stMsg = stMsg & vbNewLine & dent.Address(external:=external)
Next dent
MsgBox header & stMsg
End Sub
Function findPrecedents(rng As Range) As Collection
Set findPrecedents = findDents(rng, True)
End Function
Function findDependents(rng As Range) As Collection
Set findDependents = findDents(rng, False)
End Function
Function findExternalPrecedents(rng As Range) As Collection
Set findExternalPrecedents = findExternalDents(rng, True)
End Function
Function findExternalDependents(rng As Range) As Collection
Set findExternalDependents = findExternalDents(rng, False)
End Function
'Gives back only the dependencies that are not on the same sheet as rng
Function findExternalDents(rng As Range, precDir As Boolean) As Collection
Dim dents As New Collection
Dim dent As Range
Dim d As Variant
Dim ws As Worksheet
Set ws = rng.Worksheet
For Each d In findDents(rng, precDir)
Set dent = d
With dent
If Not (.Worksheet.Name = ws.Name And .Worksheet.Parent.Name = ws.Parent.Name) Then _
dents.Add Item:=dent
End With
Next d
Set findExternalDents = dents
End Function
'this procedure finds the cells which are the direct precedents/dependents of the active cell
'If precDir is true, then we look for precedents, else we look for dependents
Function findDents(rng As Range, precDir As Boolean) As Collection
'Need to unhide sheets for external dependencies or the navigate arrow won't work
Call mUnhideAll
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim dents As New Collection
Dim bNewArrow As Boolean
'Appliciation.ScreenUpdating = False
If precDir Then
ActiveCell.showPrecedents
Else
ActiveCell.ShowDependents
End If
Set rLast = rng
iArrowNum = 1
iLinkNum = 1
bNewArrow = True
Do
Do
Application.Goto rLast
On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=precDir, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
If Err.Number > 0 Then Exit Do
On Error GoTo 0
If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
bNewArrow = False
dents.Add Item:=Selection
iLinkNum = iLinkNum + 1 ' try another link
Loop
If bNewArrow Then Exit Do
iLinkNum = 1
bNewArrow = True
iArrowNum = iArrowNum + 1 'try another arrow
Loop
rLast.Parent.ClearArrows
Application.Goto rLast
Set findDents = dents
End Function
Sub mUnhideAll()
'
' mUnhideAll Macro
'
' Unhide All
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next
'Sheets("Sprint Schedule Worksheet").Visible = False
End Sub
Excel's built in support, as you're finding, is limited and can be extremely frustrating.
In my experience, I've found a couple of tools from http://www.aivosto.com/ to be useful; Visustin v6 is especially useful for code related auditting/processing.
Here's a simpler version of Colm Bhandal's findDents and findExternalDents. It assumes all worksheets were made visible and arrows were cleared before use.
Function findDents(rCell As Range, bPrec As Boolean) As Collection
'Return all direct precedents (bPrec=True) or dependents (bPrec=False) of rCell
Dim sAddr As String, nLink As Integer, nArrow As Integer
Const bAbs As Boolean = False, bExt As Boolean = True
Set findDents = New Collection
If bPrec Then
rCell.showPrecedents ' even if rCell has no formula
Else
rCell.showDependents
End If
On Error Resume Next ' ignore errors
sAddr = rCell.Address(bAbs, bAbs, xlA1, bExt)
nArrow = 1
Do
nLink = 1
Do
rCell.NavigateArrow bPrec, nArrow, nLink
If ActiveCell.Address(bAbs, bAbs, xlA1, bExt) = sAddr Then Exit Do
findDents.Add Selection ' possibly more than one cell
nLink = nLink + 1
Loop
If nLink = 1 Then Exit Do
nArrow = nArrow + 1
Loop
On Error GoTo 0
If bPrec Then
rCell.showPrecedents Remove:=True
Else
rCell.showDependents Remove:=True
End If
End Function
Function findExternalDents(rCell As Range, bPrec As Boolean) As Collection
'Return ...Dents that are NOT in the same workbook and worksheet as rCell
Dim rDent As Range, wsName As String, wbName As String
With rCell.Worksheet: wsName = .Name: wbName = .Parent.Name: End With
Set findExternalDents = New Collection
For Each rDent In findDents(rCell, bPrec)
If rDent.Worksheet.Name <> wsName Or rDent.Worksheet.Parent.Name <> wbName Then findExternalDents.Add Item:=rDent
Next rDent
End Function
You might want to modify this to use a SortedList instead of a Collection. In that case, change
findDents.Add Selection
to
findDents.Add Selection.Address(bAbs, bAbs, xlA1, bExt), Null