So for example (the Then statement isn't correct, I'm trying to figure out what to put there):
For i = 1 to 20
If Instr(1, Cells(i, "A"), "#goggle.com") > 0 Then
"#goggle.com" = "#google.com"
Next i
So let's say the email "somebody#goggle.com" is in cell A2, so Instr finds "#goggle.com" in A2. If I want to change the #goggle.com to #google.com, how would I do that?
My goal is to find common misspellings of email domains and fix them.
To fix your code you can use the Replace function, as mentioned
For i = 1 To 20
If InStr(1, Cells(i, "A"), "#goggle.com") > 0 Then
Cells(i, "A") = Replace(Cells(i, "A"), "#goggle.com", "#google.com")
End If
Next
but to be more efficient about all replacements use the Range().Replace method for a list of values and replacements:
Option Explicit
Public Sub fixColumnSpelling()
Const FIND_LIST As String = "#goggle.com #yahho.com #test1.com"
Const REPL_LIST As String = "#google.com #yahoo.com #test2.com"
Dim totalItems As Long, i As Long, findItems As Variant, replItems As Variant
findItems = Split(FIND_LIST)
replItems = Split(REPL_LIST)
totalItems = UBound(findItems)
For i = 0 To totalItems 'bulk replecements in col A
ActiveSheet.UsedRange.Columns(1).Replace _
What:=findItems(i), _
Replacement:=replItems(i), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False
Next
End Sub
Look into the Replace Statement.
In this instance:
Replace(Cells(i, "A"), "#google.com", "#gmail.com")
Basically the formula says, in this string `Cells(i,"A") find "#google.com" and replace it with "#gmail.com"
With this you will not need the if statement as the replace function will not replace anything that it does not find. In other words, if "#google.com" is not found in the string it moves on and returns nothing.
Related
My VBA is kind of rusty. I have the following problem: I have a column that contains labels for a questionnaire, and there is a lot of extra words tacked on to each label making them almost unreadable. The sentences I need to get rid of are very similar but come with different punctuation and can either appear in the beginning of the cell of in the middle. All sentences start with the word "Using". Here are some examples of cells that I need to clean up (3 main types):
1) "ABC123: - Using a scale of 1 to 5 ... . SomeText1" (sentence to remove starts with "Using" and ends with ".")
2) "DEF456: - Using a 1 to 5 point scale ... : SomeText2" (sentence to remove starts with "Using" and ends with ":")
3) "SomeTextLongerThan20Characters - Using a 1-5 point sca" (sentence to remove starts in the middle of the cell and is cut off in the middle)
I need these 3 cases to look like this:
1) "ABC123: SomeText1"
2) "DEF456: SomeText2"
3) "SomeTextLongerThan20Characters"
Here is my code that I could not get to work:
Sub Edit_String()
'
' Edit_String Macro
' Replaces chosen string with another string or nothing
'
Dim MyRange, c As Range
Dim strA, strB As String
For Each c In MyRange
Select Case Left(c.Text, 20)
Case Left(c.Text, 20) Like "*- Using*"
strA = "- Using*."
Case Left(c.Text, 20) Like "*: Using*"
strA = "- Using*:"
' Case Else
' If Left(c.Text, 20) <> "*Using*" Then strA = "- Using*"
End Select
Selection.Replace What:=strA, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next c
MsgBox ("macro finished running")
End Sub
The last Case Else is commented out since I figured I don't need it.
I'd appreciate any help. This seems like a simple wildcard/find/replace issue, but I can't figure it out.
If your original code works for you besides the case statement. This will get the case statement working.
Sub Edit_String()
'
' Edit_String Macro
' Replaces chosen string with another string or nothing
'
Dim MyRange, c As Range
Dim strA, strB As String
[A1] = "ABC123: - Using a scale of 1 to 5. ... . SomeText1"
[A2] = "DEF456: - Using a 1 to 5 point scale ... : SomeText2"
[A3] = "SomeTextLongerThan20Characters - Using a 1-5 point sca"
Set MyRange = [a1:a3]
For Each c In MyRange
c.Select
Select Case True
Case Left(c.Text, 20) Like "*- Using*"
strA = "- Using*."
Case Left(c.Text, 20) Like "*: Using*"
strA = "- Using*:"
' Case Else
' If Left(c.Text, 20) <> "*Using*" Then strA = "- Using*"
End Select
Selection.Replace What:=strA, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next c
You should be able to put the following in a blank workbook to test.
Sub GetSentence()
Dim MyRange, c As Range
Dim strA, strB As String
Dim SplitItUp As Variant
Dim LeftPart, RightPart As String
[A1] = "ABC123: - Using a scale of 1 to 5. ... . SomeText1"
[A2] = "DEF456: - Using a 1 to 5 point scale ... : SomeText2"
[A3] = "SomeTextLongerThan20Characters - Using a 1-5 point sca"
Set MyRange = [a1:a3]
UsingLit = " - Using"
For Each c In MyRange
SplitItUp = Split(c.Value, UsingLit)
If UBound(SplitItUp) = 0 Then
Debug.Print UsingLit + " Not Found"
Else
LeftPart = Trim(SplitItUp(0))
RightPart = Trim(SplitItUp(UBound(SplitItUp)))
If InStr(RightPart, ":") Then
SplitItUp = Split(c.Value, ":")
RightPart = SplitItUp(UBound(SplitItUp))
Else
SplitItUp = Split(c.Value, ".")
If UBound(SplitItUp) > 0 Then
RightPart = SplitItUp(UBound(SplitItUp))
Else
RightPart = ""
End If
End If
End If
Debug.Print LeftPart + " " + RightPart
Next c
End Sub
I was googling for this but if there was a way to use excels find and replace to do this. I figured it out myself and I want to put the answer here if anyone else was in the same boat as me. The trick is to type in the search the start of the word with a asterix, add one space, put another asterix and what it should end with.
I am trying to evaluate multiple pieces of information from various columns then output value if the answers meet certain conditions.
I have tried doing an extended select case statement but I know my syntax is wrong or it is not possible to do it the way I am trying to do it. It also throwing the error "type mismatch". Not the full code but a portion.
Dim EJ As String
Dim EL As String
Dim EX As String
Dim EZ As String
Dim EG As String
EJ = GetCellValue(.Cells(i, "EJ"))
EL = GetCellValue(.Cells(i, "EL"))
EX = GetCellValue(.Cells(i, "EX"))
EZ = GetCellValue(.Cells(i, "EF"))
EG = GetCellValue(.Cells(i, "EG"))
Select Case EJ And EL And EX And EZ
Case GetCellValue(.Cells(i, "EJ")) = "YES" And _
GetCellValue(.Cells(i, EL")) "YES" And _
GetCellValue(.Cells(i, "EX")) = "YES" And _
GetCellValue(.Cells(i, "EZ")) = "YES"
.Cells(i, "FI") = Done
I would like to output the word done in a column if the conditions are met.
Select Case is probably not the best choice for this - a regular If...ElseIf...Else would be fine
If EJ="YES" And EL="YES" And EX="YES" And EZ="YES" Then
.Cells(i, "FI") = "Done" '<< added quotes here
Else
'etc etc
End If
This might be significantly different depending on what your other tests look like
The loop can be avoided with Excel Formulas. For example if i is from 2 to 9 :
.Range("FI2:FI9").Formula = "=IF(AND(EJ2=""YES"", EL2=""YES"", EX2=""YES"", EZ2=""YES""), ""Done"", """")"
.Range("FI2:FI9").Value = .Range("FI2:FI9").Value ' optional to convert the formulas to values
You can also accomplish your task using a filter...
With Range("A1").CurrentRegion 'change to meet your range
.AutoFilter
.AutoFilter Field:=140, Criteria1:="YES"
.AutoFilter Field:=142, Criteria1:="YES"
.AutoFilter Field:=154, Criteria1:="YES"
.AutoFilter Field:=156, Criteria1:="YES"
On Error Resume Next
Dim rng As Range
Set rng = Range("Z2:Z" & Cells(Rows.Count, "Z").End(xlUp).Row)
Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
rng.Offset(, 9).Value = "Done"
End With
Note: Inserting the text in a column for visible rows, without looping, is adapted from an answer by Gary's Student to SO question, 28609977.
I have a list of PO numbers. They look something like (4010059877-TUR36036133 or TUR6039716## 4010073239). I need to be able to narrow the cell down to only the PO number which is the 4010059877 number. The only consistent part about the part I want to exclude is the "TUR########".
I have worked on code that excludes all non-numeric characters, but some of the cells have these "TUR #'s". I worked on a find and replace with a wildcard "*". I have also searched the web and didn't see anything similar.
Find and Replace attempted code
Sub Replace()
Columns("AJ").Replace What:="TUR*", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Replacing all non-numeric characters which leaves behind unwanted numbers behind the TUR########
Dim finRow As String
finRow = Sheets("Data").Range("A20000").End(xlUp).Row
Set myRange = Sheets("Data").Range("AK2:AK" & finRow)
For Each myCell In myRange
LastString = ""
For I = 1 To Len(myCell.Value)
mT = Mid(myCell.Value, I, 1)
If mT Like "[0-9]" Then
tString = mT
Else
tString = ""
End If
LastString = LastString & tString
Next I
myCell.Value = LastString
Next
My expected result would be for the TUR######## to be eliminated and replaced with nothing.
You can use InStr() function and then use that to support Left, such that:
loc = instr(mycell,"TUR")
val = left(mycell.value,loc-1)
Edit1:
Due to SJR's comment, will add an example of handling the issue when "TUR" is found in position 1:
loc = instr(mycell,"TUR")
if loc = 1 then
val = ""
else
val = left(mycell.value,loc-1)
end if
Edit2:
Dim val as long 'assumes you will only have a number in the end
val = right(left(mycell.value,12),11)
mycell.value = val
This should cut the first parenthesis off and have no issues with the info after the 11 digit PO. This could even be specific to the case (a switch) where instr(mycell.value,"TUR") is true, in case you have other possible scenarios.
We can also try doing a regex replacement:
Dim Regex As System.Text.RegularExpressions.Regex
Dim input As String = "4010059877-TUR36036133"
Dim output As String = Regex.Replace(input, "([0-9]+)-TUR[0-9]+", "$1")
Console.WriteLine(output)
This outputs: 4010059877
I am new to both VBA and stackoverflow. So please be patient ;).
I searched for a solution but could not find it.
My problem is as follows:
I have a column (A) with names and then a column (B) where some cells contain an "X" and others do not. I want to know which names have an "X" besides them.
Example:
I want now a string as a result, in one cell.
In this example:
Noah;Jacob;Elijah;Jayden
I got not very far.
For r = 1 To 20
If Cells(r, 2) = "X" Then A = Cells(r, 1) Else
Next
Then "A" is "Noah" and I can write it in a cell, but I want it to find all values and then write them combined, preferable seperated by ; in a cell.
Does anyone have any idea?
Create a string variable, then append your results to that variable based on "X" being in column B. Here's an example of how you could do it:
Sub Foo()
Dim i As Integer
Dim result As String
For i = 1 To 20
If UCase(Cells(i, 2).Value) = "X" Then
result = result & Cells(i, 1).Value & ";"
End If
Next
'// output the result to C1
Range("C1").Value = Left$(result, Len(result) - 1)
End Sub
Excel's native worksheet formulas do not handle concatenating an unknown number of strings together and compensating for the maximum number possible can get messy. A User Defined Function¹ (aka UDF) takes advantage of VBA's ability to process loops through a large number of rows while making numerical or string comparisons 'on-the-fly'.
build_List UDF
Function build_List(rNAMs As Range, rEXs As Range, vEX As Variant, _
Optional delim As String = ";", _
Optional bCS As Boolean = False)
Dim str As String, rw As Long, cl As Long
With rNAMs.Parent
Set rNAMs = Intersect(.UsedRange, rNAMs)
Set rEXs = .Cells(rEXs.Rows(1).Row, rEXs.Columns(1).Column). _
Resize(rNAMs.Rows.Count, rNAMs.Columns.Count)
End With
With rNAMs
For rw = .Rows(1).Row To .Rows(.Rows.Count).Row
For cl = .Columns(1).Row To .Columns(.Columns.Count).Row
If (.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl) = vEX And bCS) Or _
(LCase(.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl)) = LCase(vEX)) Then _
str = str & .Cells(rw, cl).Value & delim
Next cl
Next rw
End With
build_List = Left(str, Len(str) - Len(delim))
End Function
In D7 (as per image below) as,
=build_List(A:A, B:B, "x")
Applying the build_Lists UDf to your sample data
¹ A User Defined Function (aka UDF) is placed into a standard module code sheet. Tap Alt+F11 and when the VBE opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste the function code into the new module code sheet titled something like Book1 - Module1 (Code). Tap Alt+Q to return to your worksheet(s).
Mate Juhasz answered the question very nice and simple, but now the answer dissapeared.
Mate wrote:
For r = 1 To 20
If Cells(r, 2) = "X" Then A = A & "; " & Cells(r, 1) Else
Next
And for me that solved it perfectly. Now "A" is a string as I wanted. Thank you so much!
Good Day,
really need some help here, im bad at VBA.
Had created a spreadsheet and recorded a macro to record checkin of staff. However, im having difficulties checking out with the corresponding users based on the name.
Could anyone help me out over here?
Thanks. Had attached the spreadsheet for your ref.
http://www.etechnopia.com/vish/Book1ss.xlsm
After much googling, This is what i did based on mikes solution
Dim name As String
Dim id As Integer
Dim checkin As Date
Dim checkout As Date
name = Range("d6").Value
id = Range("d7").Value
checkin = Now
Range("d10") = checkin
Help anyone? im my very best here.
firstly I recommend to use range names for the important cells of your sheet
D6 EmpName
D7 EmpNo
D10 ClockInTime
D11 ClockOutTime
H5..H11 DataTable
This will enable you to reference them by name instead of hardcoding their addresses (bad bad hardcoding :-/ )
Secondly, your [Button] must serve a dual purpose ... it has to decide if a user is clocked in or out and do different things
a hi-level META code, executed at pressing [Button4] could be
if user clocked in
write current time into ClockOutTime ' remark: this may be superfluous
find DataTable record (EmpName, ClockInTime)
write ClockOutTime into record (EmpName, ClockInTime)
erase EmpName, EmpID, ClockInTime, ClockOutTime
else
write current time into ClockInTime
find first blank record in DataTable
write EmpName, EmpID, ClockInTime into DataTable record
endif
How to decide if a user is clocked in? If many users are using the same sheet at the same time (meaning 5 emps go there, write in their names and clock in) you need to examine DataTable for the first record of EmpNane without a ClockOutTime - if found he/she is in and needs to be clocked out.
more later ...
OK ... sorry was interrupted by Lady Gaga concerto in Vienna/AT
so here's a full code for the button
Sub ButtonPressed()
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
If Range("EmpName") = "" Or Range("EmpNo") = "" Then
MsgBox "Enter your name and ID before pressing the button", vbCritical + vbOKOnly, "missing input"
Exit Sub
End If
Idx = UserClockedIn()
If Idx <> 0 Then
DB(Idx, 4) = Date + Time()
DB(Idx, 5).Formula = "=" & DB(Idx, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & DB(Idx, 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
DB(Idx, 5).NumberFormat = "[hh]:mm"
Range("EmpName") = ""
Range("EmpNo") = ""
Else
Idx = 2
Do While DB(Idx, 1) <> ""
Idx = Idx + 1
Loop
DB(Idx, 1) = Range("EmpName")
DB(Idx, 2) = Range("EmpNo")
DB(Idx, 3) = Date + Time()
End If
End Sub
Private Function UserClockedIn() As Integer
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
UserClockedIn = 0
Idx = 2
Do While DB(Idx, 1) <> ""
If DB(Idx, 1) = Range("EmpName") And DB(Idx, 2) = Range("EmpNo") And DB(Idx, 4) = "" Then
UserClockedIn = Idx
Exit Function
End If
Idx = Idx + 1
Loop
End Function
#user502908: I have not documented it because I want you to find out exactly what it does and by that have a quick start into Excel-VBA :-) It doesn't do too much and there are some basic thechniques you will apply again & again if you go into VBA ... try to populate ranges "ClockInTime" and "ClockOutTime" :-)))
Book1ssNew.xlsm
have fun
I tried another simpler method which i could cope with
Sub yes()
Dim findId As Integer
Dim FirstAddress As String
Dim FindString As Integer
Dim Rng As Range
FindString = Range("d7").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("F1:J100")
Set Rng = .find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
FirstAddress = Rng.Address
Rng.Offset(0, 2).Value = Now()
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Search entire spreadsheet given id, when id found, to indicate dynamically the checkin timing.