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
Related
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.
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
Hi I am new to this Excel VBA , I am getting a runtime compilation error in the following Macro -
ActiveCell.FormulaR1C1 = "EmployeeID"
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="1", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="2", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=ActiveCell. _
Offset(-1,0).Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
Please help me with the error in the code.
Thanks
You're getting a compile error, not a run-time error. Compilation errors are the VBA compiler saying "I don't know what this is saying, I can't run it"; run-time errors happen when the code compiles and runs, and then suddenly blows up and you're in break mode and need to debug to resume execution.
The macro recorder has a tendency to "inject" line continuation tokens to split up long member calls into multiple "physical lines"; in VBA line continuations can make a "logical" line of code span up to 20 "physical" lines in the source code file.
The token is defined as a space followed by an underscore, then a new line.
The problem is that the recorder will break up an instruction anywhere it's legal to do so, without regards to readability: it's not rare for it to split up named arguments at the := operator, and in the current case we have a member call (Range.Offset) separated from its qualifying dot (ActiveCell.).
First thing to do when cleaning up macro recorder code, is to get rid of all the line continuations.
ActiveCell.FormulaR1C1 = "EmployeeID"
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="1", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="2", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=ActiveCell.Offset(-1,0).Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Now that all the instructions are legal and the code compiles, we can look into tweaking it to make it less redundant and more efficient.
We're dependent on the ActiveCell - that's fine, but we will want to avoid dereferencing the active cell more than once, and we can do that by introducing a variable, using the Dim keyword. Cells are Range objects in the Excel object model, so we declare our variable As Range, and then we assign it using the Set keyword, because it's an object:
Dim cell As Range
Set cell = ActiveCell
Then we can do the same for the active sheet - like this:
Dim sheet As Worksheet
Set sheet = ActiveSheet
Or like this (technically more reliable):
Dim sheet As Worksheet
Set sheet = cell.Parent
The macro is making that cell's FormulaR1C1 a literal string value: that's really more a value than a formula, let alone a formula in R1C1 notation. Setting the cell's Value would make the code more explicit about its intent:
cell.Value = "EmployeeID"
Note that whatever the active cell is is getting this "EmployeeID" value: code should either validate that the cell is in row 1, or specifically write the value in row 1 if that's what it means to do:
ActiveSheet.Cells(1, cell.Column).Value = "EmployeeID"
Next we select the entire column and then work off Selection to find/replace things. We don't need to .Select anything, really:
With cell.EntireColumn
.Replace What:="0", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Replace What:="1", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Replace What:="2", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
That's redundant, we can eliminate the need for copy-pasting chunks of code by moving that part into a separate Private Sub procedure scope that only does this:
Private Sub ClearValueInColumn(ByVal Column As Range, ByVal Value As String)
Column.Replace What:=Value, _
Replacement:=vbNullString, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Now the With cell.EntireColumn block above, can become this:
ClearValueInColumn(cell.EntireColumn, "0")
ClearValueInColumn(cell.EntireColumn, "1")
ClearValueInColumn(cell.EntireColumn, "2")
The next instruction is problematic:
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
If the ActiveCell (or our cell variable) is in row 1, offsetting negative 1 rows is going to blow up, because worksheets don't have a row (or column) 0.
The good news is that the Offset is redundant, because again what we're really looking at is just cell.EntireColumn, and again we don't need to Select anything, but then the next line is also doing redundant dereferencing:
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 ...
The cell variable is referring to a cell on the active sheet, so what we really want here is to get the parent sheet of that cell, rather than to pull a sheet named "Sheet1" (which the user might rename any time - that would instantly break the code!). We've already pulled that object reference into a sheet variable, so let's use it:
sheet.Sort.SortFields.Add2 Key:=cell.EntireColumn, _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
Note that the negative row Offset, as well as the .Range("A:A") member call, are redundant. Avoid any row offsets when you're working with an entire column - especially negative offsets that could attempt to select a cell that's outside the worksheet; always validate that ActiveCell.Row and ActiveCell.Column are large enough to take the subtraction without turning zero or negative.
Lastly, if the macro doesn't really need to work off whatever the active cell is, but is really assuming that the user has selected a specific cell before running the macro, then you can set your cell to the actual cell you need the macro to work with instead of getting the current selection involved - for example this would make the macro work off cell E4:
Set cell = ActiveSheet.Range("E4")
So, that makes the cleaned-up macro look like this:
Public Sub Macro1()
Dim cell As Range
Set cell = ActiveCell
ReplaceValueInColumn(cell.EntireColumn, "0")
ReplaceValueInColumn(cell.EntireColumn, "1")
ReplaceValueInColumn(cell.EntireColumn, "2")
Dim sheet As Worksheet
Set sheet = cell.Parent
sheet.Cells(1, cell.Column).Value = "EmployeeID"
sheet.Sort.SortFields.Clear
sheet.Sort.SortFields.Add2 Key:=cell.EntireColumn, _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
End Sub
Private Sub ReplaceValueInColumn(ByVal Column As Range, ByVal Value As String)
Column.Replace What:=Value, _
Replacement:=vbNullString, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End Sub
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
I have a column in excel that has two values "Disqualified" and "Open".
I want to use an If Statement using VBA to change the disqualified values to 0 and the Open values to 1.
Here is the excel formula that shows what I want to do
=IF(H:H="Disqualified","0","1")
I think I need a for loop to loop through all the values in column H but can't seem to get this to work. Thanks
Taking the code in your self-answer, it can (and should) be refactored to get rid of the Select parts (which will almost always generate problems in the future).
Sub changeValues()
With Worksheets("your_sheet_name")
With .Range("H1:H" & .Range("H" & .Rows.Count).End(xlUp).Row)
.Replace What:="Disqualified", _
Replacement:="0", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="Open", _
Replacement:="1", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End With
End With
'I doubt if the next line is needed
'ActiveWindow.SmallScroll Down:=-66
End Sub
Well there is probably a better way of writing this but this macro does the job.
Sub changeValues()
'
' changeValues Macro
'
'
Range(Selection, Selection.End(xlDown)).Select
Selection.replace What:="Disqualified", Replacement:="0", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.replace What:="Open", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.SmallScroll Down:=-66
End Sub