I am looking to condense my script as i still have a long ways to go and even with copying and pasting this will take me a long time. I am just looking to condense the Find/Replace Functions
Function ZoneChanges()
Dim MyCell As range
Worksheets("Sheet1").Activate
Set MyCell = Application.InputBox(Prompt:="Select a cell", Type:=8)
MyCell.Replace What:="EE", Replacement:="DA", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
MyCell.Replace What:="EF", Replacement:="DB", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
MyCell.Replace What:="EG", Replacement:="DC", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
MyCell.Replace What:="EH", Replacement:="DD", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Function
Thank you!
If you have to do multiple find and replace, you could put all the values in arrays and run a loop. The problem is, that this would be slower than what you have now. But, purely to shorten the code you could do this.
Function ZoneChanges()
Dim MyCell As Range
Dim arrWhat, arrRep, i As Long
Worksheets("Sheet1").Activate
Set MyCell = Application.InputBox(prompt:="Select a cell", Type:=8)
arrWhat = Array("EE", "EF", "EG", "EH"): arrRep = Array("DA", "DB", "DC", "DD")
For i = LBound(arrWhat) To UBound(arrWhat)
MyCell.Replace What:=arrWhat(i), Replacement:=arrRep(i), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End Function
Related
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.
I have a set of data which only pulls as MMM-DD-YYYY. I'd like to convert it to a date (MM/DD/YYYY format) to look it up versus another set of data.
I recorded a macro to simply replace the months with their respective numbers individually but I know there has to be a better way to do this. Below is my
current code:
With ws1.Cells
.Replace What:="jan-", Replacement:="01-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="feb-", Replacement:="02-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="mar-", Replacement:="03-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="apr-", Replacement:="04-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="may-", Replacement:="05-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="jun-", Replacement:="06-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="jul-", Replacement:="07-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="aug-", Replacement:="08-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="sep-", Replacement:="09-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="oct-", Replacement:="10-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="nov-", Replacement:="11-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="dec-", Replacement:="12-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
This will convert your text string into a true date for the active cell:
Sub datefix()
Dim s As String
s = ActiveCell.Value
arr = Split(s, "-")
ActiveCell.Value = arr(1) & " " & arr(0) & " " & arr(2)
End Sub
You can format it or loop it to your heart's content.
(I am using US locale)
EDIT#1:
With your desired format:
Sub datefix()
Dim s As String
s = ActiveCell.Value
arr = Split(s, "-")
ActiveCell.Value = arr(1) & " " & arr(0) & " " & arr(2)
ActiveCell.NumberFormat = "mm/dd/yyyy"
End Sub
Before:
and after:
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
My code wont run on the whole workbook just the one I'm active on.
I want it to run on every sheet in the workbook
Probably just a simple fix
Sub Remove_symbol()
'remove "Â" from data
Dim ws As Worksheet
Dim Rng1 As Range
For Each ws In ThisWorkbook.Worksheets
Set Rng1 = Range(Cells.Address)
Rng1.Replace What:="~Â", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'and duplicates
Rng1.Replace What:="~(pH Unit)(pH Unit)", Replacement:="(pH Unit)", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Rng1.Replace What:="~(µS/cm)(µS/cm)", Replacement:="(µS/cm)", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Rng1.Replace What:="~(mg/L)(mg/L)", Replacement:="(mg/L)", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Rng1.Replace What:="~(µg/L)(µg/L)", Replacement:="(µg/L)", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next ws
End Sub
You are defining a worksheet object calls ws for your loop, but you are not using it anywhere. You need to use it to qualify your Range object when you set it. You should also use it to qualify your Cells reference:
Update it to this:
Set Rng1 = ws.Range(Cells.Address)
or possibly this:
Set Rng1 = ws.Range(ws.Cells.Address)
Set Rng1 = Range( needed to be Set Rng1 = ws.Range(
Thanks to braX for the answer in the comments
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