Formula Editing Macro?

[Michael Link]

I have a large spreadsheet with many iterations of the same basic formula:

=IF($F18="Y",IF(V18<U18,IF(U18=0,0,WORKDAY(U18,X$17,$Z$5:$AB$13)),IF(V18=0,0,WORKDAY(V18,X$17,$Z$5:$AB$13))),IF(V18<U18,IF(U18=0,0,WORKDAY(U18,X$17,$Z$5:$Z$13)),IF(V18=0,0,WORKDAY(V18,X$17,$Z$5:$Z$13))))

Users often need to edit the embedded WORKDAY functions to add or subtract
days from the value referenced in X17. In the example above, a user would
need add "+7" after the "X17" to add 7 days, and they need to do it four
times since the WORKDAY function appears four times. (They can't just change
the value in X17, because other cells feed off of X17 which do not require
adjustment.)

Is it possible to write a macro to simplify this routine, so that, when run,
a pop-up box would ask the user for the number of days they want to add or
subtract from the WORKDAY function in the active cell's formula, no matter
what that larger formula's syntax was? (Essentailly, the macro would need to
identify and alter ONLY the WORKDAY function in the active cell.) Or is this
just one of those impossible things?

Thanks for any guidance anyone can offer!

Depressed in Excelworld

 

[JMB]

Can you set up a separate cell for the adjusment, and just reference that
cell in your formulae?

 

[Michael Link]

Unfortunately, I'm not sure if that's practical. The spreadsheet is very
large, and some version of this same formula appears in many cells, so I'd be
increasing the size of the sheet beyond practicality with all the input cells
I'd require.

I truly think I'm just screwed.

Thanks for the suggestion, though!

 

[JMB]

Give this a try. You should be able to select the cells you want changed,
and run the macro. It will pop up an inputbox, negative numbers s/b input as
such (ie -7), positive numbers just input as a number and it will put in the
+ sign. It will add/subtract whatever you input from the second parameter of
the workday functions in the formula.

The NG will probably wrap/break some of the lines in the wrong places, so
you'll need to correct when you paste into a module.


Sub test()
Dim strFormula As String
Dim strWkDayFormula1 As String
Dim strWkDayFormula2 As String
Dim strInput As String
Dim lngStart1 As Long
Dim lngEnd1 As Long
Dim lngStart2 As Long
Dim lngEnd2 As Long
Dim rngCell As Range

strInput = InputBox("Input Number")
If Not IsNumeric(strInput) Then Exit Sub

For Each rngCell In Selection.Cells
Do
lngStart1 = lngStart1 + 1
strFormula = rngCell.Formula
lngStart1 = InStr(lngStart1, strFormula, _
"WorkDay", vbTextCompare)
If lngStart1 > 0 Then
lngEnd1 = InStr(lngStart1, strFormula, ")", vbTextCompare)
strWkDayFormula1 = Mid(strFormula, lngStart1, _
lngEnd1 - lngStart1 + 1)
lngStart2 = InStr(1, strWkDayFormula1, ",", vbTextCompare)
lngEnd2 = InStr(lngStart2 + 1, strWkDayFormula1, _
",", vbTextCompare)
strWkDayFormula2 = Left(strWkDayFormula1, lngEnd2 - 1) & _
IIf(Left(strInput, 1) = "-", "", "+") & strInput & _
Right(strWkDayFormula1, Len(strWkDayFormula1) - lngEnd2 + 1)
rngCell.Formula = Left(strFormula, lngStart1 - 1) & _
strWkDayFormula2 & Right(strFormula, _
Len(strFormula) - lngEnd1)
End If
Loop Until lngStart1 = 0
Next rngCell

End Sub

 

[Michael Link]

OH MY GOD! JMB, you are FABULOUS! This is EXACTLYwhat I needed--I didn't
think it was possible! I didn't see your reply until I came to work this
morning, but what a wonderful way to start the day! It works perfectly.

You have totally saved my ass. I wish I could hit the "Yes" button to the
"Was this reply helpful?" question on this page about thirty thousand times.
Thank you thank you thank you!

 

[JMB]

You're welcome. Thanks for the feedback.

One caveat that I did not think about until later. The macro will append
whatever you want to add, so if you run it multiple times on the same
formulae you could get

X$17 + 10 - 5

I made some changes so it will ask if you want to replace existing
additions/subtractions. Based on the answer, it should either append or
replace additions/subtractions to the second parameter of the workday
functions. There's probably a cleaner way of doing it, but I don't have more
time today to make it more elegant.

Sub test()
Dim strFormula As String
Dim strWkDayFormula1 As String
Dim strWkDayFormula2 As String
Dim strInput As String
Dim lngStart1 As Long
Dim lngEnd1 As Long
Dim lngStart2 As Long
Dim lngEnd2 As Long
Dim lngStart3 As Long
Dim lngTemp1 As Long
Dim lngTemp2 As Long
Dim lngAnswer As Long
Dim Answered As Boolean
Dim rngCell As Range

strInput = InputBox("Input Number")
If Not IsNumeric(strInput) Then Exit Sub

For Each rngCell In Selection.Cells
Do
lngStart1 = lngStart1 + 1
strFormula = rngCell.Formula
lngStart1 = InStr(lngStart1, strFormula, _
"WorkDay", vbTextCompare)
If lngStart1 > 0 Then
lngEnd1 = InStr(lngStart1, strFormula, ")", vbTextCompare)
strWkDayFormula1 = Mid(strFormula, lngStart1, _
lngEnd1 - lngStart1 + 1)
lngStart2 = InStr(1, strWkDayFormula1, ",", vbTextCompare)
lngEnd2 = InStr(lngStart2 + 1, strWkDayFormula1, _
",", vbTextCompare)
lngTemp1 = InStr(lngStart2, strWkDayFormula1, _
"+", vbTextCompare)
lngTemp2 = InStr(lngStart2, strWkDayFormula1, "-", _
vbTextCompare)
If (lngTemp1 > 0) Xor (lngTemp2 > 0) Then
lngStart3 = Application.Max(lngTemp1, lngTemp2)
ElseIf lngTemp1 > 0 And lngTemp2 > 0 Then
lngStart3 = Application.Min(lngTemp1, lngTemp2)
Else: lngStart3 = 0
End If
If (lngStart3 > 0) And Not Answered Then
lngAnswer = MsgBox("Replace existing addition/subtraction?", vbYesNo)
Answered = True
ElseIf Not Answered Then
lngAnswer = vbNo
End If
strWkDayFormula2 = Left(strWkDayFormula1, IIf(lngAnswer = vbYes, _
lngStart3, lngEnd2) - 1) & IIf(Left(strInput, 1) = "-", "", "+") & _
strInput & Right(strWkDayFormula1, Len(strWkDayFormula1) - lngEnd2 + 1)
rngCell.Formula = Left(strFormula, lngStart1 - 1) & _
strWkDayFormula2 & Right(strFormula, _
Len(strFormula) - lngEnd1)
End If
Loop Until lngStart1 = 0
Next rngCell

End Sub

 

[JMB]

Sorry, but ran into some issues w/running it on multiple cells. I will fix
and repost.

 

[JMB]

The problem was when some of the formulae already had an addition (X$17+5)
and some did not (just X$17) and I replied yes to replace the existing
additions/subtractions. I added another test and it appears to be working
okay now.

Be sure to test it out on some sample data before using it.

Sub test()
Dim strFormula As String
Dim strWkDayFormula1 As String
Dim strWkDayFormula2 As String
Dim strInput As String
Dim lngStart1 As Long
Dim lngEnd1 As Long
Dim lngStart2 As Long
Dim lngEnd2 As Long
Dim lngStart3 As Long
Dim lngTemp1 As Long
Dim lngTemp2 As Long
Dim lngAnswer As Long
Dim Answered As Boolean
Dim rngCell As Range

strInput = InputBox("Input Number")
If Not IsNumeric(strInput) Then Exit Sub

For Each rngCell In Selection.Cells
lngStart1 = 0
Do
lngStart1 = lngStart1 + 1
strFormula = rngCell.Formula
lngStart1 = InStr(lngStart1, strFormula, _
"WorkDay", vbTextCompare)
If lngStart1 > 0 Then
lngEnd1 = InStr(lngStart1, strFormula, ")", vbTextCompare)
strWkDayFormula1 = Mid(strFormula, lngStart1, _
lngEnd1 - lngStart1 + 1)
lngStart2 = InStr(1, strWkDayFormula1, ",", vbTextCompare)
lngEnd2 = InStr(lngStart2 + 1, strWkDayFormula1, _
",", vbTextCompare)
lngTemp1 = InStr(lngStart2, strWkDayFormula1, _
"+", vbTextCompare)
lngTemp2 = InStr(lngStart2, strWkDayFormula1, "-", _
vbTextCompare)
If (lngTemp1 > 0) Xor (lngTemp2 > 0) Then
lngStart3 = Application.Max(lngTemp1, lngTemp2)
ElseIf lngTemp1 > 0 And lngTemp2 > 0 Then
lngStart3 = Application.Min(lngTemp1, lngTemp2)
Else: lngStart3 = 0
End If
If (lngStart3 > 0) And Not Answered Then
lngAnswer = MsgBox("Replace existing addition/subtraction?", vbYesNo)
Answered = True
ElseIf Not Answered Then
lngAnswer = vbNo
End If
strWkDayFormula2 = Left(strWkDayFormula1, IIf((lngAnswer = vbYes) _
And (lngStart3 > 0), lngStart3, lngEnd2) - 1) & _
IIf(Left(strInput, 1) = "-", "", "+") & _
strInput & Right(strWkDayFormula1, Len(strWkDayFormula1) - lngEnd2 + 1)
rngCell.Formula = Left(strFormula, lngStart1 - 1) & _
strWkDayFormula2 & Right(strFormula, _
Len(strFormula) - lngEnd1)
End If
Loop Until lngStart1 = 0
Next rngCell

End Sub