I have a VB.Net function in an Excel addin that I need to find the first occurrence of a string in a worksheet, then return the entire value of the cell. For example, if cell F4 contains "apples and oranges", then Findit("apples") should find a range of $F$4, and return "apples and oranges".
In the code below, I'm getting the correct range stored in MatchedRange, but I can't figure out how to use that to get the value of that cell. I know I need to make the cell active, but that's where I'm struggling.
Private Sub FixFormulasButton_OnClick(sender As Object, control As IRibbonControl, pressed As Boolean) Handles FixFormulasButton.OnClick
Dim ws As Object = CType(ExcelApp.ActiveSheet, Excel.Worksheet)
Dim cells As Object = ws.Cells
Dim MatchRange As Object = CType(cells.Find("apples", LookAt:=Excel.XlLookAt.xlPart, Lookin:=Excel.XlFindLookIn.xlFormulas), Excel.Range)
If MatchRange Is Nothing Then
MessageBox.Show("found no apples", "do nothing", MessageBoxButtons.OK)
Else
MessageBox.Show(the contents of the cell at the range found above)
End if
End Sub
Related
I wrote a simple translator / parser to process an EDI (830) document using multiple Select Case statements to determine the code to be executed. I’m opening a file in binary mode and splitting the document into individual lines, then each line is split into the various elements where the first element of every line has a unique segment identifier.
My code works perfectly as written. However, Select Case requires checking every Case until a match is found or the Case Else is executed. I’ve sequenced the Case statements in such a manner that the segments that appear most frequently (as in the case of loops), are placed first to minimize the number of "checks before code is actually executed.
Rather than using multiple Select Cases, I would prefer to determine an index for the segment identifier and simply call the appropriate routine using that index. I’ve used jump tables in C and Assembler and anticipated similar functionality may be possible in VBA.
You can do jump tables in VBA by using the Application.Run method to call the appropriate routine by name. The following code demonstrates how it works:
Public Sub JumpTableDemo()
Dim avarIdentifiers() As Variant
avarIdentifiers = Array("Segment1", "Segment2")
Dim varIdentifier As Variant
For Each varIdentifier In avarIdentifiers
Run "Do_" & varIdentifier
Next varIdentifier
End Sub
Public Sub Do_Segment1()
Debug.Print "Segment1"
End Sub
Public Sub Do_Segment2()
Debug.Print "Segment2"
End Sub
You can do this in Excel VBA, following the example below:
The example assumes you have split your EDI document into two columns, one with the 'processing instruction' and one with the data that instruction will process.
The jump table is to the right i.e. a distinct list of the 'processing instructions' plus a name of a Sub-routine to run for each instruction.
The code is:
Option Explicit
Sub JumpTable()
Dim wsf As WorksheetFunction
Dim ws As Worksheet
Dim rngData As Range '<-- data from your file
Dim rngCell As Range '<-- current "instruction"
Dim rngJump As Range '<-- table of values and sub to run for value
Dim strJumpSub As String
Dim strJumpData As String
Set wsf = Application.WorksheetFunction '<-- just a coding shortcut
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
Set rngData = ws.Range("A2:A17") '<-- change to your range
Set rngJump = ws.Range("E2:F4") '<-- change to your circumstances
For Each rngCell In rngData
strJumpSub = wsf.VLookup(rngCell.Value, rngJump, 2, False) '<-- lookup the sub
strJumpData = rngCell.Offset(0, 1).Value '<-- get the data
Application.Run strJumpSub, strJumpData '<-- call the sub with the data
Next rngCell
End Sub
Sub do_foo(strData As String)
Debug.Print strData
End Sub
Sub do_bar(strData As String)
Debug.Print strData
End Sub
Sub do_baz(strData As String)
Debug.Print strData
End Sub
Make sure that you have written a Sub for each entry in the jump table.
I'm going crazy trying to find a way for code to run when I click on ANY of the checkboxes on my sheet. I've seen multiple articles talking about making a class module, but I can't seem to get it to work.
I have code that will populate column B to match column C. Whatever I manually type into C10 will populate into B10, even if C10 is a formula: =D9. So, I can type TRUE into D10 and the formula in C10 will result in: TRUE and then the code populates B10 to say: TRUE. Awesome... the trick is to have a checkbox linked to D10. When I click the checkbox, D10 says TRUE and the formula in C10 says TRUE, but that is as far as it goes. The VBA code does not recognize the checkbox click. If I then click on the sheet (selection change), then the code will run, so I know I need a different event.
It is easy enough to change the event to "Checkbox1_Click()", but I want it to work for ANY checkbox I click. I'm not having ANY luck after days of searching and trying different things.
here is the code I'm running so far
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 3 To 11
Range("B" & i).Value = Range("c" & i)
Next i
End Sub
Any help would be appreciated.
this works
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
.
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
Private Sub ChkBoxGroup_Click()
Debug.Print "ChkBoxGroup_Click"; vbTab;
Debug.Print ChkBoxGroup.Caption; vbTab; ChkBoxGroup.Value
ChkBoxGroup.TopLeftCell.Offset(0, 2) = ChkBoxGroup.Value
End Sub
.
' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Const numChkBoxes = 20
'
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes() ' creates a column of checkBoxes
Dim sht As Worksheet
Set sht = ActiveSheet
Dim i As Integer
For i = 1 To sht.Shapes.Count
' Debug.Print sht.Shapes(1).Properties
sht.Shapes(1).Delete
DoEvents
Next i
Dim xSize As Integer: xSize = 2 ' horizontal size (number of cells)
Dim ySize As Integer: ySize = 1 ' vertical size
Dim t As Range
Set t = sht.Range("b2").Resize(ySize, xSize)
For i = 1 To numChkBoxes
sht.Shapes.AddOLEObject ClassType:="Forms.CheckBox.1", Left:=t.Left, Top:=t.Top, Width:=t.Width - 2, Height:=t.Height
DoEvents
Set t = t.Offset(ySize)
Next i
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
All you need is to let EVERY checkbox's _Click() event know that you want to run the Worksheet_SelectionChange event. To do so you need to add the following line into every _Click() sub:
Call Worksheet_SelectionChange(Range("a1"))
Please note that it is irrelevant what range is passed to the SelectionChange sub since you do not use the Target in your code.
I have an Excel formula that gives me the last Friday's date "=TODAY()-WEEKDAY(TODAY())-1" in cell A1
I want to update cell A1 only when the values in reference range in another worksheet B2:D469 changes.
Below is the code i am using but the issue is code only works when i manually make a change in the range. However values in the range gets updated when source pivot table refresh. I want code to get updated when i refresh the pivot table and the values in the range "B2:D469" changes.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Worksheets.("Source").Range("B2:D469")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Worksheets.("Dashboard").Range ("A1").EnableCalculation = True
End If
End Sub
Range.Dependents
Range has a property Dependents which is a Range containing all cells that this Range affects, even if they are several steps removed. For example if C4 is "=B4" and B4 is "=A4", Range("A4").Dependents will include both B4 and C4.
So, in your case, if Target affects a cell you care about, it's included in the Range Target.Dependents. You can use this to accomplish your goal.
How to use it
Use the following as the code of ThisWorkbook. I've commented the heck out of it, but if you have questions feel free to ask in the comments.
Option Explicit
Private RangeToMonitor As Range
Private RangeToChange As Range
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'---If this is the first change since the workbook has been opened, define the ranges---
If RangeToMonitor Is Nothing Then
Set RangeToMonitor = Worksheets("Source").Range("B2:D469")
Set RangeToChange = Worksheets("Dashboard").Range("A1")
End If
'---------------------------------------------------------------------------------------
'First, check to see if Target is in the RangeToMonitor
If Not Application.Intersect(Target, RangeToMonitor) Is Nothing Then
'If so, set your date. Rather than using a formula in the cell - which could go haywire if someone messes with it - just set it straight from VBA
RangeToChange.Value = Date - Weekday(Date) - 1
'Second, check to see if a change to Target *triggers* any recalculation of cells in RangeToMonitor.
'You can do this by looking at Dependents, which is all the cells affected by a change to Target, even several steps removed
ElseIf hasDependents(Target) Then
'(The above and below criteria cannot be done in one if condition because VBA boolean operators do not short circuit)
If Not (Application.Intersect(Target.Dependents, RangeToMonitor) Is Nothing) Then
RangeToChange.Value = Date - Weekday(Date) - 1
End If
End If
End Sub
'The reason for this function is that trying to use Target.Dependents when Target has no Dependents causes an error
'I use this function to verify that Target DOES have Dependents before attempting to find out if any of them affects RangeToMonitor
Private Function hasDependents(rng As Range)
On Error GoTo ErrHandler
Dim test As Long
test = rng.DirectDependents
hasDependents = True
Exit Function
ErrHandler:
If Err.Number = 1004 Then
'"No Cells Were Found"
'This error signifies that Target has no Dependents, so we can safely ignore the change and exit the event.
hasDependents = False
Else
Err.Raise Err.Number, , Err.Description
End If
End Function
I know that this probably isn't the most ideal way to to do this but just bear with me.
I have a document with a few tables on it. I'm using a userform to search the tables/sub-categories and return the relevant values. I want to select the sub categories with a range of option buttons on a userform, these will in turn set the range for the search function to look within. I also want to dynamically update the option buttons if a new table was to be added or anything along those lines.
The only thing that differentiates the title of a sub-category/table, and the items within it, is that the title of a sub-category/table is bold. So what I'm looking to do is search the first column of the spreadsheet and return the names of any entries in bold. These values are then used to set the names of the option buttons :).
The following function is my attempt at finding the text entities in column a that are in bold, returning them and setting each to an individual variable to be used in another function. The bold1 .... variables are all globally defined variables as I need them in another sub, as is the page variable which contains the relevant page to be used. Currently the code returns an error stating "variable or with block not set" and using the debugger I can see that bold1 .... and all the other boldx variables have no value set. Does anybody know whats going on/how to fix this function.
Thanks in advance :)
Sub SelectBold()
Dim Bcell As Range
For Each Bcell In Worksheets(Page).Range("A1:A500")
If Bcell.Font.Bold = True Then
Set bold1 = Bcell
End If
Next
End Sub
EDIT: I simplified the above function, to remove clutter and help narrow in on the issue. I want the above function to store the contents of the found cell (any cell in the document in bold at this stage) in the variable bold1
This will return an array of values from bold cells in column A of Page.
You can fill a combo or list box with theses values using their list property.
ComboBox1.List = getSubCategories("Sheet1")
Function getSubCategories(Page As String) As String()
Dim arrSubCategories() As String
Dim count As Long
Dim c As Range
With Worksheets(Page)
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
If c.Font.Bold Then
ReDim Preserve arrSubCategories(count)
arrSubCategories(count) = c.Value
count = count + 1
End If
Next
End With
getSubCategories = arrSubCategories
End Function
you may find useful to have a Range returned with subcategories cells found:
Function SelectBold(Page As String, colIndex As String) As Range
With Worksheets(Page)
With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
.FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
.Value = .Value
If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
.Clear
End With
End With
End Function
Function IsBold(rCell As Range)
IsBold = rCell.Font.Bold
End Function
to be possibly exploited as follows:
Option Explicit
Sub main()
Dim subCategoriesRng As Range, cell As Range
Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in
If Not subCategoriesRng Is Nothing Then
For Each cell In subCategoriesRng '<--| loop through subcategories cells
'... code
Next cell
End If
End Sub
I'm trying to populate a List Box (ActiveX control). This list box is on a sheet labeled "Dashboard" of my workbook, and not a user form. I want to populate it with a range from a sheet labeled "Data".
My problem is that if I populate it on the workbook open event procedure, I get an error when the workbook opens that it "Can't execute in break mode." However, there aren't breakpoints active at all.
If I populate it on the "Dashboard" worksheet active event procedure, it won't populate when the workbook is open. It only populates if I click on another worksheet, and then go back to the Dashboard worksheet, then it will populate.
Is there a better way to populate the list box so that it's always populated and ready to go? I have a lot of vLookup functions that are associated with the list box, and if the list box is not populated, then the rest of my code won't work.
I will post my codes that I have so far. The first is when I attempt to populate the listbox through the workbook_open even procedure. The second is through the "Dashboard" worksheet activate procedure.
Private Sub Workbook_Open()
Dim strName As String
Dim blDone As Boolean
Dim cPlanets As MSForms.ListBox
Dim vArray As Variant
Dim shtData As Worksheet
Dim wkbSolarSystem As Workbook
Set wkbSolarSystem = Application.Workbooks("workbookname.xlsm")
Set shtData = wkbSolarSystem.Worksheets("Data")
Set cPlanets = wkbSolarSystem.Worksheets("Dashboard").lstPlanets
vArray = shtData.Range("Planets").value
cPlanets.List = vArray
cPlanets.ListIndex = 3
'input box message for user when workbook opens up
strName = InputBox("Hello! Please enter your name", "Welcome!")
'check if there is a name entered via loop and if statement
Do
If Len(strName) = 0 Then
'if no name entered, ask user again
MsgBox ("Please enter a valid name to continue"), vbCritical, "Valid Name Required"
'ask user to type in name again
strName = InputBox("Hello! Please enter your name", "Welcome!")
Else
'display message with information for user
MsgBox ("Hello, " & strName)
blDone = True
End If
'finish loop statement
Loop Until blDone = True
This next code is the one I have on Sheet3 code worksheet activate procedure
Private Sub Worksheet_Activate()
Dim shtData As Worksheet
Dim wkbSolarSystem As Workbook
Set wkbSolarSystem = Application.Workbooks("workbookname.xlsm")
Set shtData = wkbSolarSystem.Worksheets("Data")
lstPlanets.List = shtData.Range("Planets").value
lstPlanets.ListIndex = 3
End Sub
You are declaring cPlanets as MSForms.ListBox, but in your question you say you are working with an ActiveX listbox on a sheet. So you should declare cPlanets as an Object, like:
Dim cPlanets As Object
Set cPlanets = wkbSolarSystem.Worksheets("Dashboard").lstPlanets
I tried this code on a different computer, and it works. It seems that it's the computer configuration that was causing the issue. The code works fine as it should on several different computers.