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
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'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
first post :)
I have the following code below, which selects all within a set column and clears the two text phrases, from row 12 down.
What i want is to have the user input the column instead? possibly via InputBox?
Sub ClearColumn()
Dim lastCell As Long
Dim myRange As Range
' Find lastCell in column Z
lastCell = Cells(Rows.Count, "Z").End(xlUp).Row
' Set range to look at
Set myRange = Range("Z12:Z" & lastCell)
' Replace All Pass
myRange.Replace What:="Go", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Replace All Fail
myRange.Replace What:="Stop", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Welcome to Stack Exchange. You seem to have answered your own question. Below code is untested, but should take a small amount of time to implement.
Sub ClearColumn()
Dim lastCell As Long
Dim chooseColumn As Variant
Dim myRange As Range
chooseColumn = InputBox("Which Column do you want to alter?")
' Find lastCell in column Z
lastCell = Cells(Rows.Count, chooseColumn ).End(xlUp).Row
' Set range to look at
Set myRange = Range(chooseColumn &"12:"&chooseColumn & lastCell)
' Replace All Pass
myRange.Replace What:="Go", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Replace All Fail
myRange.Replace What:="Stop", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Let us know how you go :)
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
The below macro is set to run every sheet but my main sheet. After it runs my formulas in column C are gone and the clean up section never ran, so there is access text in each row.
Sub testV2()
Dim ws As Worksheet
ActiveWorkbook.RefreshAll
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Macro" Then
Columns("A:A").Select
Selection.Replace What:="*identified", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="as*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Range("$A$1:$A$10000").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
With ws.UsedRange
.Value = .Value
End With
End If
Next ws
End Sub
I think the problem is that you didn't activate the currently used sheet to remove the duplicates from it. That way ActiveSheet always refers to the sheet that was selected when you started running the code. Does it work with the following code?
Sub testV2()
Dim ws As Worksheet
ActiveWorkbook.RefreshAll
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Macro" Then
Columns("A:A").Select
Selection.Replace What:="*identified", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="as*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ws.Activate
ActiveSheet.Range("$A$1:$A$10000").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
End If
Next ws
End Sub