There are times when I'm building an electronics project with 1000+ components. I encoded my bill of materials (BOM) on excel. Say, 10K resistor for R1 to R5 so I put in there "Resistor 10K" then on "location" I will put "R1-5" or "R1-R5". This is good as it facilitates easy inputting of location without having to type "R1 R2 R3 R4 R5". So the BOM is completed in this way. Perfect! All in place. Later on, I want to know the value of say "R4" on my BOM containing 500+ different resistors. I search "R4"... only to know that excel cannot find the string "R4" because I did put R1-R5. This means there's really no "R4" at all.
The question now is how do I facilitate easy inputting of location without worrying that excel "find" cannot locate it? Probably excel vba can help solve this common pitfall. Well perfect! vba contains rich string manipulation that can solve this one.
Lets look at some "mostly" (to me) used excel vba string manipulation function:
1.)
Lcase
-Lcase converts all characters on string arguments into lowercase.
Example:
Dim Thisstring As String
Dim convertedtolowercase As String
Thisstring = "THIS IS ALL UPPER CASE STRING TO BE CONVERTED TO LOWERCASE THRU LCASE FUNCTION"
convertedtolowercase = LCase(Thisstring)
MsgBox convertedtolowercase
This displays a message box:
2.)
UCase
-The reverse of Lcase. UCase converts all characters on string arguments into Uppercase.
Example:
Dim Thisstring As String
Dim convertedtouppercase As String
Thisstring = "this is all lower case string to be converted to uppercase thru ucase function"
convertedtouppercase = UCase(Thisstring)
MsgBox convertedtouppercase
This displays a message box:
3.) InStr
InStr( [start], string, substring, [compare] )
-Will find “substring” occurrence on the “string” starting from “[start]”
and will return the integer location.
Example:
Dim Thisstring As String
Dim asterishlocation As Integer
Thisstring = "Find the character * on this string"
asterishlocation = InStr(1, Thisstring, "*", vbTextCompare) 'asterish is text no. 20
MsgBox asterishlocation
This displays a message box:
4.) InStrRev
InStrRev(string, substring, [start], [compare] )
-Will find “substring” occurrence on the “string” starting from “[start]” but this time the search will starts from the right. Will do the similar to InStr but in reverse (from right) order. Will return the integer location –still in reference to the left as count=1.
Example (find the asterish “*”:
Dim Thisstring As String
Dim asterishlocationright As Long
Dim asterishlocationrleft As Long
Thisstring = "First * location and second * location"
asterishlocationright = InStrRev(Thisstring, "*", -1, vbTextCompare) ‘will find the second * which is 29 charaters from left
asterishlocationrleft = InStr(1, Thisstring, "*", vbTextCompare) ‘will find the first* which is 7 charaters from left
MsgBox "asterishlocationright= " & asterishlocationright
MsgBox "asterishlocationrleft= " & asterishlocationrleft
This displays a message boxes:
5.)
Trim
Trim(string)
-Will remove the spaces (non characters) on the left and right of the string.
Example:
Dim Thisstring As String
Dim trimmedstring As String
Thisstring = " Has lot of spaces "
trimmedstring = Trim(Thisstring)
MsgBox Thisstring
MsgBox trimmedstring
This displays a message boxes:
You notice that the untrimmed string displays with the spaces.
6.) Len
Len(string)
-Will return how many characters are in the string.
Example:
Dim Thisstring As String
Dim StringLength As Long
Thisstring = "This is a 41 long string including spaces"
StringLength = Len(Thisstring)
MsgBox StringLength
This displays a message box:
7.) Left
Left(string,[length])
-Will get a string with “[length]” (# of characters) from the left of “string”.
Example:
Dim Thisstring As String
Dim LeftString As String
Thisstring = "Take characters from the left"
LeftString = Left(Thisstring, 4) ‘Take 4 characters from the left
MsgBox LeftString
This displays a message box:
8.) Right
Right(string,[length])
-Will get a string with “[length]” (# of characters) from the right of “string”.
Example:
Dim Thisstring As String
Dim RightString As String
Thisstring = "Take characters from the Right"
RightString = Right(Thisstring, 5) 'Will take 5 characters from the right
MsgBox RightString
This displays a message box:
9.) Mid
Mid(string,[start],[length])
-Will get a string with “[length]” (# of characters) starting from “[start]” of “string”.
Example:
Dim Thisstring As String
Dim MidString As String
Thisstring = "Take characters on the middle"
MidString = Mid(Thisstring, 5, 10) 'Will take 10 characters starting from character 5
MsgBox MidString
This displays a message box:
Think that's all Guys! Anyway, here's the logic of say extending "R1-R5" to "R1 R2 R3 R4 R5"
1.) Find the character "-".
2.) Then any numerals after it until either space or end of the whole string is the "end count". 5 in the above example.
3.) Similarly any number before the "-" is the "beginning count". 1 in the above example.
4.) The letter before the "-" until either space or beginning of the whole string is the "Letter designation". "R" in the above example.
So I did came up with a function where is accepts 3 arguments and do the above extending automatically:
Extend(RowFrom As Integer, RowTo As Integer, Column As Integer)
RowFrom - an integer which designates the row to where the extending begins.
RowTo - an integer which designates the row to where the extending ends.
Column - an integer which designates the column to where the extends will operates.
Here's the code:
'===========================================================
Public Sub Extend(RowFrom As Integer, RowTo As Integer, Column As Integer)
On Error GoTo tap
Dim RowEval As Integer
Dim Previous As Integer
Dim Find As Integer
Dim CRight As Integer
Dim CLeft As Integer
Dim BLeft As Boolean
Dim BRight As Boolean
Dim HiCount As String
Dim LoCount As String
Dim HighRange As Long
Dim LowRange As Long
Dim Prefix As String
Dim LocCounter As Long
CRight = 1
CLeft = 1
BRight = False
BLeft = False
HiCount = ""
LoCount = ""
Prefix = ""
Previous = 1
Find = 100
If (RowFrom > RowTo) Then
MsgBox "Row from is greater than Row To"
Exit Sub
End If
For RowEval = RowFrom To RowTo
Cells(RowEval, Column).Select
ActiveCell.FormulaR1C1 = Trim(ActiveCell.FormulaR1C1)
Do While (Find <> 0)
CRight = 1
CLeft = 1
BRight = False
BLeft = False
HiCount = ""
LoCount = ""
Prefix = ""
Previous = 1 'This is no longer needed cause the
'first dash found is already extended
'so previous can be always equal to 1
Find = 100
Find = InStr(Previous, ActiveCell.FormulaR1C1, "-", vbtextcompare)
If Find = 0 Then
GoTo nextrow
End If
Do While (IsNumeric(Mid(ActiveCell.FormulaR1C1, Find + CRight, 1)) = False)
CRight = CRight + 1
Loop
Do While (BRight = False)
HiCount = HiCount + Mid(ActiveCell.FormulaR1C1, Find + CRight, 1)
HighRange = Val(HiCount)
CRight = CRight + 1
If (Find + CRight - 1 = Len(ActiveCell.FormulaR1C1)) Then
GoTo GetLeft
End If
If (IsNumeric(Mid(ActiveCell.FormulaR1C1, Find + CRight, 1)) = False) Then
BRight = True
End If
Loop
GetLeft:
CRight = CRight - 1
Do While (IsNumeric(Mid(ActiveCell.FormulaR1C1, Find - CLeft, 1)) = False)
CLeft = CLeft + 1
Loop
Do While (BLeft = False)
LoCount = Mid(ActiveCell.FormulaR1C1, Find - CLeft, 1) + LoCount
If left(LoCount, 1) <> "0" Then
LowRange = Val(LoCount)
End If
CLeft = CLeft + 1
If (IsNumeric(Mid(ActiveCell.FormulaR1C1, Find - CLeft, 1)) = False) Then
BLeft = True
End If
Loop
Do While (IsNumeric(Mid(ActiveCell.FormulaR1C1, Find - CLeft, 1)) = False)
Prefix = Mid(ActiveCell.FormulaR1C1, Find - CLeft, 1) + Prefix
CLeft = CLeft + 1
If ((Find - CLeft) = 0) Then
CLeft = CLeft - 1
GoTo GetPrefix
End If
Loop
CLeft = CLeft - 1
GetPrefix:
Prefix = Trim(Prefix)
ActiveCell.Characters(Start:=Find - CLeft, Length:=CLeft + CRight + 1).delete
For LocCounter = HighRange To LowRange Step -1
ActiveCell.Characters(Start:=Find - CLeft, Length:=0).Insert " " & Prefix & LocCounter & " "
Next LocCounter
Previous = Find + 1 'This is no longer needed cause the
'first dash found is already extended
'so previous can be always equal to 1
Loop
nextrow:
CRight = 1
CLeft = 1
BRight = False
BLeft = False
HiCount = ""
LoCount = ""
Prefix = ""
Previous = 1
Find = 100
Next RowEval
Exit Sub
tap:
MsgBox Err.Number & " " & Err.Description
End Sub
'===================================================================
Testing it here's the output:
it works!!!!
Good Luck Guys!!!....
No comments:
Post a Comment