VBA Excel - Proper Case Exceptions? - excel
I have a macro written to convert customer names and titles to proper case if they aren't already. The problem with that is I sometimes have a list with abbreviations or acronyms (ie "High School" = "HS" ; Limited Partnership = "LP").
The issue is that my macro will proper case what should remain in upper case. To work around this I have a few exceptions written into my macro. Here's an example:
Dim fndList As Variant
Dim rplcList As Variant
Dim F As Long
fndList = Array("'S", "Xdock", "Llc", "Us ", "Urs", "Lc ", "Bbq", "Dq")
rplcList = Array("'s", "XDock", "LLC", "US ", "URS", "LC ", "BBQ", "DQ")
For F = 0 To UBound(fndList)
Selection.Replace What:=fndList(F), Replacement:=rplcList(F), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Is there a way to write a rule that recognizes if the term is not a word then it defaults to upper case?
The other issue I have with my temporary solution is that some words containing the array will revert to upper case (ie: "Famous" = "FamoUS" ; "Alcohol" = "ALCohol" ; "Yourselves" = `YoURSelves").
Appreciate any help, pleae let me know if you require more info on my part.
Related
Replacing Dot to comma in VBA
I have an issue when I try to replace all "." with ","
It works normal when I use Ctrl + H in the Excel Sheet and do it manually.
I have recorded the Macro from what I do in the sheet, and got this code
Columns("Q:S").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
But when I run the Macro it only removes the "." , instead of replacing it with "," .
So for instance, if the cell states 4.000 aftter I run the Macro, it returns 4000.
How do I fix this??
I have also tried changing decimal separators in the system, but it does not help me.
Thank you for your help.
This should replace all the periods with commas regardless of data type. (as a string, so you'll no longer be able to easily calculate from them)
You'll still be running into a lot of trouble if you want these numbers to be numbers, with correct separators.
As a side note, When I used find and replace (Ctrl + H) I got the same result where my "4.123" became "4,123.00". This may be related to our system settings.
Sub Test_Replace_Period_with_Comma()
Dim ValueRange As Range
Dim ValueSet
Dim X As Long
Dim Y As Long
Set ValueRange = Intersect(Columns("Q:S"), Sheet8.UsedRange)
ValueSet = ValueRange
If ValueRange.Cells.Count = 1 Then
ReDim ValueSet(1 To 1, 1 To 1)
End If
For X = 1 To UBound(ValueSet, 1)
For Y = 1 To UBound(ValueSet, 2)
'Debug.Print ValueSet(X, Y)
If ValueSet(X, Y) <> "" Then
ValueSet(X, Y) = Replace(CStr(ValueSet(X, Y)), ".", ",", 1, , vbTextCompare)
End If
Next Y
Next X
ValueRange.NumberFormat = "#"
ValueRange = ValueSet
End Sub
Runtime error 5 because variable comes up as nothing when it shouldn't
I have been trying to fix a inventory log for my work that has been around for years and has always had this bug. The script is supposed to look at a provided tag number, figure out if it has been returned or not and then mark the item as returned if the name matches. For tag numbers 1501 through 2040 it works perfectly fine, however once you attempt to search tag numbers 2041 to 2300 it will immediately throw a Code 5 error and crash the script. Debug says the range = nothing
here is the main code:
Dim AmbRng As Range
Dim answer As VbMsgBoxResult
TheDate = Format(Date, "mm/dd/yy")
TheTime = Format(Time, "Medium Time")
findstring = ByItemNumberTextBox.Value
If Trim(findstring) <> "" And Trim(findstring) >= 1501 And Trim(findstring) <= 2300 Then
With Sheets("AmbBay").Range("AmbBay_Ticket_Numbers")
Set AmbRng = .Find(What:=findstring, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Application.Goto AmbRng, True
The debug always points to the last line and says AmbRng = nothing. I presume this is an integer overflow but I haven't been able to find a workaround through google or here. My VBA skills are rudimentary and self taught, so I assume I am missing something simple. Any help would be appreciated.
GMalc answered the question in the comments, I appreciate everyone's help.
Replacing a string of text when only knowing a certain amount of characters
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
VBA - Txt file with two delimiters for rows and columns
I have a .txt file where columns are delimited with | (pipe) but rows are delimited with the following string: _ ~|~ _ Is there a way to import this by delimiting rows based on the string? If I could just do that, I would be able to do text to columns easily. This is tricky because the space in each row in Notepad is being exhausted. For example: Policy|Name|Cost _ ~|~ _ 11924|Joe|$20 _ ~|~ _ 154 (end of notepad space) 35|Bob|$40 _ ~|~ _ 18439|Jane|$30 _ ~|~ _ 18492|Ri chard|$50 I need this to read: Policy Name Cost 11924 Joe $20 15435 Bob $40 18439 Jane $30 18492 Richard $50 and so on. Note that values at the far right are split because notepad has exhausted its line length. Thanks for any ideas!
You can pre-process the text before importing to Excel using a more powerful text editor such as TextPad. In TextPad, do a Replace (F8 key). First let's get rid of your so called "end of notepad space" which I read as line breaks. Use regular expression to replace double carriage returns "\n\n" with nothing: Then, replace pipes "\|" with spaces " ": Then, replace "_ ~ ~ _ " with a carriage return "\n": This is the final text that should be ready to import into Excel: Hope that helps! TextPad is a great tool to have around.
You can do this in a single step using a VBA macro.
Read in the entire file to a VBA String variable
Remove the newline characters
Split on the row delimiter
This results in a 1D array
Convert the array to a 2D array
write the results to the worksheet
Do text to columns using the pipe as the delimiter
Option Explicit
'SET REFERENCE to Microsoft Scripting Runtime
Sub ImportSpecial()
Dim FSO As FileSystemObject
Dim TS As TextStream
Dim sFN As Variant
Dim S As String
Dim V As Variant
Dim R As Range
sFN = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If Not sFN = False Then
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(sFN, ForReading, False, TristateFalse)
'Remove the linefeeds
S = TS.ReadAll
S = Replace(S, vbNewLine, "")
'If data is large, will need to transpose manually
V = Application.WorksheetFunction.Transpose(Split(S, "_ ~|~ _"))
Set R = ActiveSheet.Cells(1, 1).Resize(UBound(V), 1)
With R
.EntireColumn.Clear
.Value = V
.TextToColumns Destination:=R(1), _
DataType:=xlDelimited, _
Tab:=False, semicolon:=False, comma:=False, Space:=False, _
other:=True, otherchar:="|"
.EntireColumn.AutoFit
End With
End If
End Sub
Macro for Text to columns
Sub Macro9()
'
' Macro9 Macro
'
'
Selection.TextToColumns Destination := Range("A3"), DataType := xlFixedWidth, _
FieldInfo := Array(Array(0,1),Array(60,1),Array(63,1),Array(68,1),Array(71,1), _
Array(85,1),Array(88,1),Array(93,1),Array(99,1),Array(107,1),Array(111,1),Array _
(120,1),Array(123,1),Array(127,1),Array(130,1),Array(134,1),Array(143,1),Array( _
147,1),Array(157,1),Array(162,1),Array(165,1),Array(170,1),Array(202,1),Array( _
233,1),Array(236,1),Array(238,1),Array(248,1),Array(251,1),Array(260,1),Array( _
265,1),Array(277,1),Array(283,1),Array(287,1),Array(291,1),Array(295,1),Array( _
299,1),Array(302,1),Array(306,1),Array(310,1),Array(322,1),Array(326,1),Array( _
332,1),Array(335,1),Array(338,1),Array(344,1),Array(348,1),Array(356,1),Array( _
360,1),Array(367,1),Array(373,1),Array(375,1),Array(384,1),Array(387,1),Array( _
394,1),Array(398,1),Array(403,1),Array(409,1),Array(413,1),Array(419,1),Array( _
424,1),Array(429,1),Array(432,1),Array(438,1),Array(444,1),Array(449,1),Array( _
454,1),Array(458,1),Array(463,1),Array(468,1),Array(474,1),Array(478,1),Array( _
481,1),Array(484,1),Array(489,1),Array(493,1),Array(524,1),Array(554,1),Array( _
557,1),Array(563,1),Array(565,1),Array(577,1),Array(594,1),Array(613,1),Array( _
616,1),Array(620,1),Array(626,1),Array(629,1),Array(634,1),Array(646,1),Array( _
654,1),Array(659,1),Array(667,1),Array(669,1),Array(675,1),Array(683,1),Array( _
689,1),Array(696,1),Array(699,1),Array(706,1),Array(714,1),Array(717,1),Array( _
721,1),Array(728,1),Array(730,1),Array(743,1),Array(751,1),Array(754,1),Array( _
758,1),Array(767,1),Array(774,1),Array(779,1),Array(787,1),Array(790,1),Array( _
798,1),Array(805,1),Array(808,1),Array(817,1),Array(822,1),Array(826,1),Array( _
835,1),Array(845,1),Array(853,1),Array(857,1),Array(864,1),Array(869,1),Array( _
877,1),Array(881,1),Array(891,1),Array(895,1),Array(903,1),Array(912,1),Array( _
916,1),Array(920,1),Array(927,1),Array(933,1),Array(937,1),Array(941,1),Array( _
End Sub
I have 800 words in cell A3 in sheet input1, i recorded above macro by using function "Text to columns" in Excel 2007 which is giving error "Too many line continuations".
Can someone tell me the exact code please, indeed I want to add all the 800 words in different individual cells as one word in each cell in the same row.
I do not believe it is possible to tell the Macro Recorder to create longer lines so I do not think TextToColumns can be made to record this code for you.
You are using the fixed width option so words are starting at position 0, 60, 63, 68, 71 and so on. The start positions for about 120 words have been have been recorded so, if you wanted to build an array like this, you will have a lot of typing.
You say "words". To me that implies variable length strings separated by spaces. If that is correct, try the code below. It uses function Split to split cell A3 into words by space. These are then spread out along row 4 with any gaps created by double or triple spaces ignored.
Option Explicit
Sub SplitCell()
Dim CellCrnt As Long
Dim InxW As Long
Dim Word() As String
With Worksheets("input1")
Word = Split(.Range("A3"), " ")
CellCrnt = 1
For InxW = LBound(Word) To UBound(Word)
' Any double spaces will cause empty entries in Word.
' Ignore these empty entries
If Word(InxW) <> "" Then
.Cells(4, CellCrnt).Value = Word(InxW)
CellCrnt = CellCrnt + 1
End If
Next
End With
End Sub