Replace formula number values with number plus 1 - excel

I am trying to create a script in excel to duplicate sheets, rename with cell value from active sheet and then replace the formula values with the values from the row below on the main sheet labelled 'Master Working'.
For the last part, I'm trying to amend the below code recorded with a macro such that instead of '19' to '20', the existing number in the formula becomes N and replaced with N+1.
The formulas for each cell in the range are a simple lookup like the below from main tab.
='Master Working'!B19
Range("D5:D8").Select
Selection.Replace What:="19", Replacement:="20", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B14:M14").Select
Selection.Replace What:="19", Replacement:="20", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

First read your value to replace into a variable N:
Dim N As Long 'read N value from master worksheet
N = ThisWorkbook.Worksheet("Master Working").Range("B19")
Then Replace using that variable N to replace it with N + 1.
ActiveSheet.Range("D5:D8").Replace What:=CStr(N), Replacement:=CStr(N + 1), LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Range("B14:M14").Replace What:=CStr(N), Replacement:=CStr(N + 1), LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Note that I changed LookAt:=xlPart to LookAt:=xlWhole otherwies it will replace in 105193 the 19 by 20 like 105203 which is probably not what you want.

Related

swap 2 values in excel selection

In a variable selection of cells in single column, I'm needing to swap "Buy" with "Sell", and vice-versa.
I tried something like this...but when first Selection.Replace changes "Sell" to "Buy", then 2nd one just changes "Buy" back to "Sell" -
Data sample
I havent found that I can nest a Selection.Replace..would need to loop down thru each cell somehow?
....
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial
Selection.Replace What:="Bought", Replacement:="Sold", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.Replace What:="Sold", Replacement:="Bought", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
To achieve what you want, you can replace three times instead of just two times.
The solution shows how to do it, while avoiding the use of Copy, Paste and Select, to make sure we don't interfere with the user selection and the clipboard.
Sub Doit()
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng As Range
Dim Lst As Variant
' Get the range in column B from row 4 and down.
Set Rng1 = Range("B4")
Set Rng2 = Rng1.End(xlDown)
Set Rng = Range(Rng1, Rng2)
' Copy the range to column C
Lst = Rng
Range("C4").Resize(UBound(Lst, 1), UBound(Lst, 2)) = Lst
' Replace Bought with Sold and Sold with Bought
Rng.Replace What:="Bought", Replacement:="#B#o#u#g#h#t", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Rng.Replace What:="Sold", Replacement:="Bought", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Rng.Replace What:="#B#o#u#g#h#t", Replacement:="Sold", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub
The solution assumes that your data does not contain the string "#B#o#u#g#h#t". You can use whatever string you want instead of "#B#o#u#g#h#t", as long as the string does not appear in your data.
As with your example, the solution does not test, if there is any valid data in Column B from row 4 and down.

VBA - if replacement = true, change cell color to yellow

I'm working on a macro and I want to record an addon to the below code:
Selection.Replace What:="<", replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
New code needed: if the above ended up replacing <, then the cell needs to be marked in yellow (colorindex=6). Which code would allow me to do this?
You can use replace to replace the format
Dim ReplaceRange As Range
Set ReplaceRange = Selection
'define color for ReplaceFormat
With Application.ReplaceFormat.Interior
.ColorIndex = 6
End With
'replace the format and text
ReplaceRange.Replace What:="<", replacement:=vbEmpty, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True, FormulaVersion:=xlReplaceFormula2

Alternative to SendKeys Enter for activating cells in excel with vba

I'm pasting some dates from a csv file into excel using a macro, and using a find/replace to alter the format into one excel can recognise, from 2019_10_22_08_43_23 to 22/10/2019 08:43:23, for example. Excel won't recognise this text as a date until you manually select the cell and press enter, and therefore won't display the dates on a graph correctly until this has been done. My current solution is using
For Each c In cycleRange.Cells
c.Select
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Next
to manually press enter in each cell but this takes quite a long time. I have tried using TextToColumns but this isn't working. If I manually select the cell range, and navigate the data menu to click TextToColumn myself it corrects the cell format, but doing this through a macro doesn't do anything.
cycleRange.Select
Selection.TextToColumns Destination:=cycleRange, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
What's the fastest method to replace looping through each cell and using Sendkeys to activate them?
You want to convert each cell to number. Here is the code:
Dim cellValue As Double
For Each c In cycleRange.Cells
If IsNumeric(c.Text) Then
cellValue = c.Value
c.Clear
c.NumberFormat = "0.00"
c = Val(c.Text)
' c = c.Text * 1
' c = CDbl(c.Text)
Else
MsgBox ("Not a number (" & c.Address & ")")
End If
Next
It would be easier to combine the string conversion and cell formatting into one VBA operation
Something like this
Sub Demo()
Dim rng As Range
Dim cl As Range
Dim dat() As String
Set rng = [A1:A10] ' update to suit your needs
For Each cl In rng
If cl.Value2 Like "####_##_##_##_##_##" Then
dat = Split(cl.Value2, "_")
cl = DateSerial(dat(0), dat(1), dat(2)) + TimeSerial(dat(3), dat(4), dat(5))
cl.NumberFormat = "yy/mm/dd hh:mm:ss" ' update to suit your required format
End If
Next
End Sub
You can simulate to enter a cell and push enter by replacing a specific number by itself i.e. you replace 1 by 1. As such, the format changes. Doing this for 0, 1, then 2 up to 9 will cover all your cells, whatever figure is in the cell.
Here a macro:
Sub Repl1by1()
Cells.Replace What:="0", Replacement:="0", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="1", Replacement:="1", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="2", Replacement:="2", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="3", Replacement:="3", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="4", Replacement:="4", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="5", Replacement:="5", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="6", Replacement:="6", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="7", Replacement:="7", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="8", Replacement:="8", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="9", Replacement:="9", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Replacing multiple text in excel formula using VBA

Good morning,
I am seeking some assistance in how to properly replace multiple criteria within a formula using VBA - Excel. I have a userform at the beginning of the macro where the user will select the month that they are wanting to run the report for. I am using the previous month's report as the template and need to update the formula to reflect the proper months accordingly. I am looking to have the formula be applied to an entire column of data. I am shifting each month in the formula forward one month to capture the previous four (4) months of data.
For example: I am running a report for AUG. I will be using the JUL report that was ran the previous month as the template.
The formula that is currently in the report:
=sum('JUL18'!$E$19+'JUN18'!$E$19+'MAY18'!$E$19+'APR18'!$E$19)/B6
I would like the formula to update to:
=sum('AUG18'!$E$19+'JUL18'!$E$19+'JUN18'!$E$19+'MAY18'!$E$19)/B6
The code I currently have is:
If FormMonth.Value = "AUG" Then
Columns("D:D").Select
Selection.Replace What:="JUL", Replacement:="AUG", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="JUN", Replacement:="JUL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="MAY", Replacement:="JUN", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="APR", Replacement:="MAY", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="MAR", Replacement:="APR", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="FEB", Replacement:="MAR", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
-The end result is as follows:
=sum('AUG18'!$E$19+'AUG18'!$E$19+'JUN18'!$E$19+'MAY18'!$E$19)/B6
The first and last two months in the formula appear to update properly, however the JUN (supposed to update to JUL) jumps to AUG. It's as if it continues to loop through until it reaches the chosen form month.
Any ideas as to why this may be? Still becoming acclimated with VBA so the code may not be the prettiest.
You really don’t need a macro, you can use indirect function.
formulas you will need:
'=TEXT(EOMONTH(B2,-1),"MMM")
'=SUM(INDIRECT(B5&"!A1"),INDIRECT(B6&"!A1"),INDIRECT(B7&"!A1"))
You can try something like this to reduce the amount of repetitive code. Also, removed instanced of .Select
Sub Test()
Dim Arr1: Arr1 = Array("JUL", "JUN", "MAY", "APR", "MAR", "FEB")
Dim Arr2: Arr2 = Array("AUG", "JUL", "JUN", "MAY", "APR", "MAR")
Dim i As Long
With ThisWorkbook.Sheets("Sheet1").Range("D:D")
For i = LBound(Arr1) To UBound(Arr2)
.Replace What:=Arr1(i), Replacement:=Arr2(i), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End With
End Sub

Excel VBA selection.replace and if replaced put text in column a of the replaced row

I have some macro like:
Columns("F:M").Select
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
But i want to put the current date (or even just a string of text) to be put in cell A of the row where a replace occurred.
I imagine you will need to change your replace to a find and replace. Something like:
Dim c As Range
Columns("F:M").Select
Set c = Selection.Find(What:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False)
If Not c Is Nothing Then
Do
c.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells(c.Row, 1).Value = Date
Set c = Selection.FindNext(c)
Loop While Not c Is Nothing
End If

Resources