×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Are you an
Engineering professional?
Join Eng-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

# general purpose VBA routines that you find useful ?3

 Forum Search FAQs Links MVPs

## general purpose VBA routines that you find useful ?

(OP)
I'd be interested to hear if you have any general purpose excel vba routines that you find especially helpful

The one I'll present is one that was discussed in another thread thread770-485250: Excel formula help please

In there I had presented a cell highlighter routine so you can keep track of the current cell if you have multiple windows open (excel's built in current-cell highlighter disappears if you shift focus to another window).
That previous version did have the undesirable characteristic of wiping out some existing formatting of the sheet.
3DDave made a comment which suggested that conditional formatting could overcome that limitation.
I have redone that code to use conditional formatting for highlighting, and that fixed the problem, it doesn't interfere with formatting (minor exception at the end):
• It doesn't wipe out any existing permanent formatting.
• It doesn't wipe out any existing conditional formatting (I wasn't as sure of this, but my experimentation supports the conclusion.
• It doesn't interfere with using the paintbrush formatter tool to paste format from current selection to another location in the same sheet.
• ...(even though you can't see the format while your cursor is in that cell due to the highlighting).
• It DOES interfere with using the paintbrush formatter tool to paste format from current selection to another location in a DIFFERENT sheet
• ... (because the target sheet doesn't have the same macro to help clear out that cell highlighting format)
• ... I don't think it's a big problem, just don't paste formats from the highlighter sheet into a different sheet
• ... ... the fact that you have a big yellow highlight in the cell is an obvious clue that naturally reminds you to think about effects of copying format from that cell
It only works on one sheet, not a whole workbook.
Below is the new code, which should be pasted into the code area for a particular sheet, NOT into a module area.
Let me know if you have any problem with it. And let us know your own favorite general purpose vba routines

#### CODE

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

' Current Cell row/column highlighter
' update 072121 - uses conditional formating, and "union"
' Usage note - if for some reason a cell remains highlighted
'     ... which is not the current cell, then fix it by
'     ... clicking on that cell and then clicking on any other cell

Static lastRow, lastCol ' Holds the cell coordinates from last call to sub

Dim mySheet As Sheet1
Dim thisRange, lastRange As Range
Dim thisFC, lastFC As FormatCondition
Set mySheet = Target.Parent

' Clear highlighting from last (previous) cell from last call to this function:
If lastRow <> "" Then  ' don't proceed if empty values (when initially open workbook)
Set lastRange = Union(mySheet.Rows(lastRow), mySheet.Columns(lastCol)) '  builds a range that highlights both row and column of last cell
With lastRange
For Each lastFC In .FormatConditions
If lastFC.Type = xlExpression And (lastFC.Formula1 = "=ROW()>0") Then
lastFC.Delete
End If
Next lastFC
End With
End If

' Highlight current cell:
Set thisRange = Union(mySheet.Rows(Target.Row), mySheet.Columns(Target.Column)) '  builds a range that highlights both row and column of current cell
Set thisFC = thisRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=ROW()>0")
With thisFC
.SetFirstPriority
With .Interior
.Color = vbYellow
.Pattern = xlSolid
End With
End With

' Save lastRow and lastCol for the next call...
lastRow = Target.Row
lastCol = Target.Column

End Sub 

=====================================
(2B)+(2B)' ?

### RE: general purpose VBA routines that you find useful ?

Got quite a few, but not GP, except for one.

It supplements Excel's built-in unit conversion function. The built-in CONVERT function is quite nice with lots of units, although some options are bit weird. Not often I want to convert km to angstroms or light years. It has many basic conversions, but lacks flow rates, velocities and a lot of units particular to engineering work. It also isn't very good at giving you hints of what built-in conversion units are available and the unit abbreviations are hard to remember.

So... I wrote a module that first tries to convert my number using Excel's built-in units, but when it does not find MMCFD to m3/h, it checks my custom unit conversions and gives me the answer I want in my desired units. I also included a form with a button that lists all XL built-in units and their abbreviations for easy reference. With one leg in the US and the other in Europe, I find it is pretty helpful. Lbm/hr to kg/s, or gal/m to m3/h, W/m2 to BTU/ft2-s ... directly. No muss, no fuss.

### RE: general purpose VBA routines that you find useful ?

I despise having to do unit conversions in Excel, which is why most of my stuff involving units is done in Mathcad. All the conversion is done in the background. I enter something in angstroms, and ask for it in light years, and it does it, no fuss, little muss. Conversion factors are are the worst; was THAT one divided into the quantity or multiplied, ACK!

TTFN (ta ta for now)
I can do absolutely anything. I'm an expert! https://www.youtube.com/watch?v=BKorP55Aqvg
FAQ731-376: Eng-Tips.com Forum Policies forum1529: Translation Assistance for Engineers Entire Forum list http://www.eng-tips.com/forumlist.cfm

### RE: general purpose VBA routines that you find useful ?

(OP)
Haha, I'm going to try to slip in a length measurement in units of lightyears into one of my evaluations... then I'll find out if my boss actually reads it.

=====================================
(2B)+(2B)' ?

### RE: general purpose VBA routines that you find useful ?

Very novice VBA user here (unfortunately). But my two general purpose programs are:

1. A "Paste as Text" macro. For a spectra analysis calc, I pull the data from a standard website and the bring it to the line and paste as text. It saves me about 4-5 keystrokes and clicking through the menu.

2. A "Clear Inputs" macro. Basically helps me start a sheet fresh.

Both were created with recording, so I actually didn't have to code anything. Once I get some time I would like to start getting more coding going on to limit some of my calcs in cell. It's a slow process.

### RE: general purpose VBA routines that you find useful ?

Which version of Excel are you using? Paste as Text should be on the right-click context menu; that's faster than even hunting for a macro, unless you've installed it directly on a context menu.

TTFN (ta ta for now)
I can do absolutely anything. I'm an expert! https://www.youtube.com/watch?v=BKorP55Aqvg
FAQ731-376: Eng-Tips.com Forum Policies forum1529: Translation Assistance for Engineers Entire Forum list http://www.eng-tips.com/forumlist.cfm

### RE: general purpose VBA routines that you find useful ?

The kool thing about light years is you can use it for length, vol and time.

1,000,000,000 m3/yr = = 1E-39 m2LY
Mass rates get a little tricky.

### RE: general purpose VBA routines that you find useful ?

One thing annoying about the speed of light is that when we test laser rangefinders, we HAVE to use the speed of light in air, which hardly anyone knows, since everyone is always using the vacuum speed of light. Tiny error it is, but big enough to fail a laser rangefinder.

TTFN (ta ta for now)
I can do absolutely anything. I'm an expert! https://www.youtube.com/watch?v=BKorP55Aqvg
FAQ731-376: Eng-Tips.com Forum Policies forum1529: Translation Assistance for Engineers Entire Forum list http://www.eng-tips.com/forumlist.cfm

### RE: general purpose VBA routines that you find useful ?

One (rather large) subroutine that I use frequently is for ensuring that Excel's XY-Chart has equal scaling on its two axes. I use it whenever I am using the chart to create a data-driven diagram rather than an actual graph.

ElectricPete will recognise it, because he contributed to its evolution.

I thought I had put into my FAQ Archive, but if I did it has since disappeared.

#### CODE

Sub GiveActivePlotEqualScales()
'
'  PURPOSE
'
'  Changes the X and Y scales of an Excel XY-Scatter chart by
'  exactly the right amount to result in the two scales being equal.
'
'  The chart, which can be embedded in a worksheet or can be on its
'  own ChartSheet, has to be "active" when this subroutine runs.
'
'  The subroutine will not run on a protected worksheet unless the
'  protection allows the user to "edit objects".  However a user who
'  can "edit objects" can also mess up the plot in various ways, so
'  the protection would seem to be somewhat pointless.
'
'  HISTORY
'
'  The original subroutine was developed by Jon Peltier, and placed
'  on his PeltierTech website at URL
'  www.peltiertech.com/Excel/Charts/SquareGrid.html
'  where it was still accessible in September 2015.
'  A modified version of the routine was placed on the "Engineering
'  spreadsheets" forum of the Eng-Tips web site (www.Eng-Tips.com)
'  by contributor Panars in December 2005, in thread 770-141275.
'  Two other EngTip-ers, Electricpete and Denial then made some
'  further modifications to it as the thread developed.
'
'  In 2010 Denial posted an improved version on Eng-Tips.  See
'  thread 770-274998.   The main problem fixed was that for
'  charts with at least one axis displayed there were still some,
'  seemingly random, circumstances under which the resulting scales
'  would not be adequately equal.
'
'  MODIFICATIONS SINCE MID 2015
'
'  Sep 2015.  Correction for where a worksheet has more than one embedded
'      chart object.  (Previously chart object 1's series were used to
'      calculate the scaling factors for all the chart objects.)
'  Sep 2015.  In charts where only one axis is utilised we now set that
'      axis's MajorUnitsIsAuto parameter to True.  This avoids some grossly
'      inappropriate label spacings under some circumstances.
'  24Sep15.  This updated version was posted on Eng-Tips
'      as thread 770-395377 and as FAQ 770-1901.
'  27Sep15.  Added check for whether a chart is actually "active".
'
Dim s As Series, PointsList As Variant, PointCount As Long
Dim PlotInHt As Double, PlotInWd As Double
Dim HaveXaxis As Boolean, HaveYaxis As Boolean
Dim PlotName As String, PlotNumb As Long
Dim TypeOfPlot As Long, SubtypeOfPlot As Long
Dim IsEmbedded As Boolean
Dim Xmax As Double, Xmin As Double, Xdel As Double
Dim Ymax As Double, Ymin As Double, Ydel As Double
Dim XmaxData As Double, XminData As Double
Dim YmaxData As Double, YminData As Double
Dim Xpix As Double, Ypix As Double
Dim Distort As Double, Distort_pc As Double
Dim CycleCount As Long, MaxCycles As Long
Dim AxisControlling As String
Dim MoveDist As Double, Shift As Long
Dim Margin As Double, Temp As Double
'
Const SubName As String = "GiveActivePlotEqualScales"
'
'  Check whether there is in fact an active chart.
'
If ActiveChart Is Nothing Then
MsgBox "There is no active chart.", , "Subroutine " & SubName
Exit Sub
End If
'
'  Determine whether the active chart is embedded in a worksheet or
'  is a sheet in its own right.  (If the activesheet's type is not
'  a worksheet, assume that it is a chart.)
'
IsEmbedded = (ActiveSheet.Type = xlWorksheet)
'
With ActiveChart    'The "End With" for this is at the very end of the subroutine.
'
'  Get various properties of the chart.  Check chart type.
'
If IsEmbedded Then
PlotName = .Parent.Name
Else
PlotName = .Name
End If
TypeOfPlot = .Type
SubtypeOfPlot = .ChartType
If TypeOfPlot <> xlXYScatter Then
MsgBox "Scale-equalising macro is intended only for an XY Scatter chart.", , _
PlotName & " / " & SubName
Exit Sub
End If
'
'  Get presence/absence for each axis.
'
HaveXaxis = .HasAxis(xlCategory)
HaveYaxis = .HasAxis(xlValue)
'
'  Determine the extreme X and Y values of all the data points,
'  looping through all the data series on the chart.
'
'  Note that VBA generates an error if we try to do anything with
'  an empty series:  hence the need for the "on error" statements.
'
Xmin = 9.999999E+100:   Ymin = Xmin:   Xmax = -Xmin:   Ymax = Xmax
PointCount = 0
If IsEmbedded Then
PlotNumb = ActiveChart.Parent.Index
For Each s In ActiveSheet.ChartObjects(PlotNumb).Chart.SeriesCollection
On Error Resume Next
PointCount = PointCount + s.Points.Count
PointsList = s.XValues
Xmax = Application.Max(Xmax, PointsList)
Xmin = Application.Min(Xmin, PointsList)
PointsList = s.Values
Ymax = Application.Max(Ymax, PointsList)
Ymin = Application.Min(Ymin, PointsList)
On Error GoTo 0
Next s
Else
For Each s In .SeriesCollection
On Error Resume Next
PointCount = PointCount + s.Points.Count
PointsList = s.XValues
Xmax = Application.Max(Xmax, PointsList)
Xmin = Application.Min(Xmin, PointsList)
PointsList = s.Values
Ymax = Application.Max(Ymax, PointsList)
Ymin = Application.Min(Ymin, PointsList)
On Error GoTo 0
Next s
End If
'
'  Suppress the following two error messages, because in the present
'  context the subroutine is being initiated automatically.  (And
'  we don't want to alarm the user, do we?)
'
If PointCount <= 0 Then
'    MsgBox "Chart contains no points.", , PlotName & " / " & SubName
Exit Sub
End If
If Xmax - Xmin + Ymax - Ymin <= 1E-20 Then
'    MsgBox "Chart is of zero size.", , PlotName & " / " & SubName
Exit Sub
End If
'
'  Expand these maximum and minimum values very slightly, so that
'  line segments running along the very edge of the graph area
'  do not get missed.  If the chart sub-type is "smoothed"
'  use a bit more expansion, to allow for the smoothed edges to
'  extend beyond the actual data points.
'
'  The sizes used for these "margins" are no better than guesses.
'
Margin = 0.005
If SubtypeOfPlot = xlXYScatterSmooth Or _
SubtypeOfPlot = xlXYScatterSmoothNoMarkers Then Margin = 0.04
Temp = Margin * (Xmax - Xmin)
Xmax = Xmax + Temp
Xmin = Xmin - Temp
Temp = Margin * (Ymax - Ymin)
Ymax = Ymax + Temp
Ymin = Ymin - Temp
'
'  Record these max & min values for later use.
'
XminData = Xmin:   XmaxData = Xmax:   YminData = Ymin:   YmaxData = Ymax
'
'  If we have an X axis, find out what MajorUnit would auto-apply.
'
If HaveXaxis Then
With .Axes(xlCategory)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
.MajorUnitIsAuto = True
Xdel = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If Xmax = Xmin Then Xdel = 0
End If
'
'  If we have a Y axis, find out what MajorUnit would auto-apply.
'
If HaveYaxis Then
With .Axes(xlValue)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
.MajorUnitIsAuto = True
Ydel = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If Ymax = Ymin Then Ydel = 0
End If
'
'  If have both X and Y axes, use the larger MajorUnit for both.
'
If HaveXaxis And HaveYaxis Then
If Ydel >= Xdel Then
Xdel = Ydel
Else
Ydel = Xdel
End If
End If
'
'  For directions with axes, round the minimum values down to be
'  multiples of the axis's MajorUnit.  Round only the "minimum"
'  values, since these are the ones that serve as the base for the
'  markings along the axes.  (And if we do it for the maximum
'  as well we risk overconstraining our problem.)
'
'  At the same time, set the MajorUnit.
'  Note that the calculation for the MajorUnit needs to be
'  set to "Auto" if the axis concerned is the only axis in use,
'  or the unit spacing can be badly wrong. (MajorAxisIsAuto was
'  set to False near the start of the subroutine.)
'
If HaveXaxis And Xdel <> 0 Then
Xmin = Xdel * Round((Xmin - 0.5 * Xdel) / Xdel)
If HaveYaxis Then
.Axes(xlCategory).MajorUnit = Xdel
Else
.Axes(xlCategory).MajorUnitIsAuto = True
End If
End If
If HaveYaxis And Ydel <> 0 Then
Ymin = Ydel * Round((Ymin - 0.5 * Ydel) / Ydel)
If HaveXaxis Then
.Axes(xlValue).MajorUnit = Ydel
Else
.Axes(xlValue).MajorUnitIsAuto = True
End If
End If
'
'  Get the dimensions of the part of the chart used for the actual
'  graphing, then use these to calculate the present values of the
'  relative scaling factors in the X & Y directions.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax - Xmin) / PlotInWd
Ypix = (Ymax - Ymin) / PlotInHt
'
'  We can now set about equalising the scales.  In an ideal world
'  this would be a simple, single pass, exercise.  But it turns
'  out that, for a chart that has any axes displayed, a change to
'  the defined extents of a displayed axis will sometimes change
'  the chart's InsideWidth or InsideHeight properties.  I cannot
'  find a way to predict when this will or will not happen.
'
'  This behaviour is a major PITA.  It requires us to adopt an
'  iterative approach.  Implement the iterations with a For—Next
'  loop, and set a fairly low limit on the maximum number of
'  iterations allowed.  (But not too low:  I had one chart which
'  required 9 iterations to achieve adequately equal scales.)
'
MaxCycles = 15
For CycleCount = 1 To MaxCycles
'
'  Adjust one of the scales in an attempt to achieve equality.
'
If Ypix < Xpix Then
'
'  X DIRECTION CONTROLS THE SIZE OF THE CHART.
'
AxisControlling = "X"
'
'Set the X-axis extents to the data's extents.
'
.HasAxis(xlCategory) = True
.Axes(xlCategory).MinimumScale = Xmin
.Axes(xlCategory).MaximumScale = Xmax
If Not HaveXaxis Then .HasAxis(xlCategory) = False
'
'  Recalculate the scaling factors, which might have changed.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax - Xmin) / PlotInWd
Ypix = (Ymax - Ymin) / PlotInHt
'
'  Calculate the value of Ymax that will result in
'  the same value for the scale of the Y-axis as we
'  have just defined for the scale of the X-axis.
'
Ymax = Ymin + Xpix * PlotInHt
'
'  The available space in the Y-direction will be greater
'  than what is needed by the actual graphing.  Attempt
'  to position the graphing centrally in this space.  If
'  the chart has its Y-axis displayed, then any shift
'  must be a multiple of the MajorUnit.
'
MoveDist = 0.5 * (Ymax + Ymin - YmaxData - YminData)
If HaveYaxis Then
Shift = Round(MoveDist / Ydel, 0)
Ymin = Ymin - Shift * Ydel
Ymax = Ymax - Shift * Ydel
Else
Ymin = Ymin - MoveDist
Ymax = Ymax - MoveDist
End If
'
'  Set the Y-axis extents to these calculated values.
'
.HasAxis(xlValue) = True
.Axes(xlValue).MinimumScale = Ymin
.Axes(xlValue).MaximumScale = Ymax
If Not HaveYaxis Then .HasAxis(xlValue) = False
Else
'
'  Y DIRECTION CONTROLS THE SIZE OF THE CHART.
'
AxisControlling = "Y"
'
'  Set the Y-axis extents to the data's extents.
'
.HasAxis(xlValue) = True
.Axes(xlValue).MinimumScale = Ymin
.Axes(xlValue).MaximumScale = Ymax
If Not HaveYaxis Then .HasAxis(xlValue) = False
'
'  Recalculate the scaling factors, which might have changed.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax - Xmin) / PlotInWd
Ypix = (Ymax - Ymin) / PlotInHt
'
'  Calculate the value of Xmax that will result in
'  the same value for the scale of the X-axis as we
'  have just defined for the scale of the Y-axis.
'
Xmax = Xmin + Ypix * PlotInWd
'
'  The available space in the X-direction will be greater
'  than what is needed by the actual graphing.  Attempt
'  to position the graphing centrally in this space.  If
'  the chart has its X-axis displayed, then any shift
'  must be a multiple of the MajorUnit.
'
MoveDist = 0.5 * (Xmax + Xmin - XmaxData - XminData)
If HaveXaxis Then
Shift = Round(MoveDist / Xdel, 0)
Xmin = Xmin - Shift * Xdel
Xmax = Xmax - Shift * Xdel
Else
Xmin = Xmin - MoveDist
Xmax = Xmax - MoveDist
End If
'
'  Set the X-axis extents to these calculated values.
'
.HasAxis(xlCategory) = True
.Axes(xlCategory).MinimumScale = Xmin
.Axes(xlCategory).MaximumScale = Xmax
If Not HaveXaxis Then .HasAxis(xlCategory) = False
End If
'
'  Recalculate the scaling factors, which might have changed yet again.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax - Xmin) / PlotInWd
Ypix = (Ymax - Ymin) / PlotInHt
'
'  If the discrepancy between the scaling factors is less than
'  say 0.5%, then we can apply the Bobby McFerrin / Meher Baba
'  algorithm ("Don't worry, be happy").
'
'  Otherwise, sigh deeply and begin another iteration.
'
Distort = Abs((Xpix - Ypix) / (Xpix + Ypix))
If Distort < 0.0025 Then GoTo Finish_Off
Next CycleCount
'
'  Tell the long-suffering user that adequate convergence
'  has not been achieved.  Then carry on regardless.
'
Distort_pc = Round(100 * Distort, 1)
MsgBox "Discrepancy between scales is " & Distort_pc & "%" & Chr(13) & _
"after " & MaxCycles & " iterations.", , _
PlotName & " / " & SubName
'
Finish_Off:
'
End With        'Terminates the "With ActiveChart" near the top of the subroutine.
'
End Sub 

### RE: general purpose VBA routines that you find useful ?

General purpose stuff I use a lot:

Cubic, quartic and higher order polynomial equation solvers.
Brent's method solver (variation of Newton's method).
Section properties for defined shapes and from coordinates.
Intersection of lines defined by a series of points.
Evaluate formulas entered as text on the spreadsheet.
Unit conversion and formula evaluation with units.
Linear algebra functions, including solving large matrix equations.
Draw images to scale from coordinates.

Code for all the above can be found on the blog, but let me know if there is something specific you would like a link to.

Doug Jenkins
Interactive Design Services
http://newtonexcelbach.wordpress.com/

### RE: general purpose VBA routines that you find useful ?

Thanks, Doug.
It was a bit like the house keys, or my reading glasses:  I knew I'd put it somewhere but couldn't remember where.

### RE: general purpose VBA routines that you find useful ?

Always the last place you look :)

Doug Jenkins
Interactive Design Services
http://newtonexcelbach.wordpress.com/

### RE: general purpose VBA routines that you find useful ?

Here's my favorite UDF, it shows the numbers behind the variables in excel formulas.

#### Spoiler:

Option Explicit
Option Base 1

Public Function Disfor(x, Optional precision = 10)

Dim CallerSheet As String, CallerBook As String
Dim OriFor As String, FormularLen As Integer
Dim MathOp As Variant, i As Integer
Dim SearchStart As Integer, k As Integer
Dim SwapOp As Boolean, LastK As Integer
Dim CellAdd As String, Genfor As String, GenOpt As String
Dim Variable As Variant
Dim Bf As String, Md As String, Af As String

Static AlreadyOpen As Boolean
Application.Volatile

CallerSheet = Application.Caller.Parent.Name
CallerBook = Application.Caller.Parent.Parent.Name

MathOp = Array("=", "+", "-", "*", "/", "^", ",", ":", "<", ">")

OriFor = x.Formula
FormularLen = Len(OriFor)
ReDim Operator(FormularLen) As Integer

If Left$(OriFor, 1) <> "=" Then OriFor = "=" + OriFor FormularLen = FormularLen + 1 End If 'Replace ":\" with "|\" SearchStart = 1 Do While InStr(SearchStart, OriFor, ":\") > 0 k = InStr(SearchStart, OriFor, ":\") Mid$(OriFor, k, 2) = "|\"
SearchStart = SearchStart + 1
Loop

k = 1
For i = 1 To UBound(MathOp) '10 math operators (include ',' and ':')
SearchStart = 1
Do While InStr(SearchStart, OriFor, MathOp(i)) > 0
Operator(k) = InStr(SearchStart, OriFor, MathOp(i))
SearchStart = Operator(k) + 1
k = k + 1
Loop
Next i
Operator(k) = FormularLen + 1
LastK = k

'Sort Operator()
Do
SwapOp = False
For i = 1 To LastK - 1
If Operator(i) > Operator(i + 1) Then
'swap Operator(I), Operator(I + 1)
k = Operator(i)
Operator(i) = Operator(i + 1)
Operator(i + 1) = k
SwapOp = True
End If
Next i
Loop Until SwapOp = False

Genfor = ""
For i = 1 To LastK - 1
CellAdd = Mid$(OriFor, Operator(i) + 1, Operator(i + 1) - Operator(i) - 1) GenOpt = Mid$(OriFor, Operator(i), 1)
Call CheckBK(CellAdd, Bf, Md, Af)
GenOpt = GenOpt + Bf

If CellAdd <> "" Then

' For K = 1 To FormularLen

' Next K

Call ObtainValue(CellAdd, CallerSheet, CallerBook, Variable, precision)

Else
Variable = ""
End If

Select Case GenOpt
Case Is = ":"
GenOpt = " to "
'GenOpt = "->"
'Case Is = "*"
' GenOpt = "x"
End Select
Genfor = Genfor + GenOpt + Variable + Af

Next i

'Set supercript

Genfor = Right$(Genfor, Len(Genfor) - 1) Call ReplaceConstant(Genfor) If Left$(Genfor, 1) = "+" Then
Disfor = Right$(Genfor, Len(Genfor) - 1) Else Disfor = Genfor End If 'Replace "|\" with ":\" SearchStart = 1 Do While InStr(SearchStart, Disfor, "|\") > 0 k = InStr(SearchStart, Disfor, "|\") Mid$(Disfor, k, 2) = ":\"
SearchStart = SearchStart + 1
Loop

End Function

Sub CheckBK(ForStr As String, Bf As String, Md As String, Af As String)
'Check for Brackets ie. '()'
'Bf = before '('
'Md - between '('&')'
'Af -after ')'

Dim i As Integer, k As Integer, L As Integer
Dim Opb As Integer, Clb As Integer

L = Len(ForStr)
k = 0
Do While InStr(k + 1, ForStr, "(") > 0
k = k + 1
Loop
Opb = k
Clb = InStr(1, ForStr, ")")
If Clb = 0 Then Clb = L + 1

Bf = Left$(ForStr, Opb) ': Print "bf="; "@"; Bf$; "@"
Md = Mid$(ForStr, Opb + 1, Clb - Opb - 1) ': Print "md="; "@"; Md$; "@"
Af = Right$(ForStr, L - Clb + 1) ': Print "Af="; "@"; Af$; "@"

End Sub

Sub RmvU(Md)

'Remove unwanted formating in number format string

Dim L As Integer, NewMd As String, i As Integer
Dim TempMd As String

NewMd = ""
L = Len(Md)

For i = 1 To L
TempMd = Mid(Md, i, 1)
Select Case TempMd
Case Is = "?"
'do nothing

Case Is = "_"
i = i + 1

Case Else
NewMd = NewMd + TempMd
End Select

Next i

Md = NewMd

End Sub

Sub ObtainValue(CellAdd, CallerSheet, CallerBook, Variable, precision)
On Error GoTo NonAdd
Dim Md As String
Dim VarAdd As Object

If Asc(Left$(CellAdd, 1)) < 58 And Left$(CellAdd, 1) <> "$" Then Variable = CellAdd 'Print #1, "no address ", CellAdd Else If InStr(CellAdd, "!") = 0 Then 'Set VarAdd = Workbooks(CallerBook).Worksheets(CallerSheet).Range(CellAdd) Set VarAdd = Workbooks(CallerBook).Worksheets(Range(CellAdd).Parent.Name).Range(CellAdd) Else Set VarAdd = Range(CellAdd) End If 'With VarAdd 'Md = TypeName(Worksheets(CallerSheet).Range(CellAdd).Value) Md = TypeName(VarAdd.Value) If Md = "Empty" Or Md = "Null" Or Md = "Error" Or Md = "String" Then Variable = Md Exit Sub End If 'Print #1, CellAdd, Range(CellAdd).Value 'Variable = Str$(Range(CellAdd).Value)
'Variable = Str$(Range(CellAdd).Value) 'Md = Worksheets(CallerSheet).Range(CellAdd).NumberFormat Md = VarAdd.NumberFormat Call RmvU(Md) 'Print #1, CellAdd If Md = "General" Then 'Variable = Str$(Worksheets(CallerSheet).Range(CellAdd).Value)
Variable = Str$(Round(VarAdd.Value, precision)) Else 'Variable = Format$(Worksheets(CallerSheet).Range(CellAdd).Value, Md)
Variable = Format$(Round(VarAdd.Value, precision), Md) End If 'End With End If Exit Sub NonAdd: Variable = "Address Error" On Error GoTo 0 End Sub Sub ReplaceConstant(Genfor) 'Replace PI() with 3.142 Dim i As Integer, L As Integer, k As Integer L = Len(Genfor) For i = 1 To L If InStr(i, Genfor, "PI()") > 0 Then k = InStr(i, Genfor, "PI()") Mid$(Genfor, k, 4) = "3.142"
End If
Next i

End Sub

### RE: general purpose VBA routines that you find useful ?

Saving functions in a module and uploading the file makes a cleaner forum post.

### RE: general purpose VBA routines that you find useful ?

(OP)
Yes that looks like it would be a useful way to document both the formula (FormulaText / getformula) and the values of the input variables (yakpol's DisFor).
I wonder how hard it would be to put all numbers into a common format, like scientific with 2 decimal places.

=====================================
(2B)+(2B)' ?

### RE: general purpose VBA routines that you find useful ?

The numbers displayed have the similar format to referenced in the formula. In addition, the second argument (optional) limits precision. Like disfor(A1, 3)

### RE: general purpose VBA routines that you find useful ?

(OP)
Aha, you're way ahead of me. I didn't look close enough. Thanks.

=====================================
(2B)+(2B)' ?

### RE: general purpose VBA routines that you find useful ?

One more thing. Disfor() requires these two functions to be placed in ThisWorkbook module, they help to keep screen and print updated.

Private Sub Workbook_Activate()
Application.CalculateFull
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.CalculateFull
End Sub

Also, extensive use of this function slows down the worksheet, especially when running VBA routines.

#### Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

#### Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

#### Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login

#### Resources

Low-Volume Rapid Injection Molding With 3D Printed Molds
Learn methods and guidelines for using stereolithography (SLA) 3D printed molds in the injection molding process to lower costs and lead time. Discover how this hybrid manufacturing process enables on-demand mold fabrication to quickly produce small batches of thermoplastic parts. Download Now
Design for Additive Manufacturing (DfAM)
Examine how the principles of DfAM upend many of the long-standing rules around manufacturability - allowing engineers and designers to place a partâ€™s function at the center of their design considerations. Download Now
Taking Control of Engineering Documents
This ebook covers tips for creating and managing workflows, security best practices and protection of intellectual property, Cloud vs. on-premise software solutions, CAD file management, compliance, and more. Download Now

Close Box

# Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!