Here my example of thing that i will use.
On the left side is the patch it will use NAME BASE REVISE to check the version of package.
Can you convert the script here in to VBA code. I will study about it and integrate to my real work:
if (Patch name = Pack name) then **** searching for same Name on patch column to reference for patch base and revise number
if (base(c column) > base(h column)) ***checknumber[cellbycell]
display "yes" in J cell
or if (base(C column) = base(h column)) then
check if revise(D column) > revise(I column)
display "yes" in J cell
else display No
So if you can give me example code ; if you have sometime please explain to me that what each line of code is meaning.
You don't need vba for this
=IF($A2=$G2,IF($C2>$H2,"Yes",IF($C2=$H2,IF($D2>$I2,"Yes","No"),"No")),"No")
That goes in column J
something like this should work:
Option Explicit
Sub variousconditions()
Dim i As Integer, x As Integer
x = 0
For i = 2 To 10
With Excel.ThisWorkbook.ActiveSheet
If .Cells(i, 1) = .Cells(i, 7) Then '****searching for same Name on patch
Select Case .Cells(i, 3) '***checknumber[cellbycell]
Case Is > .Cells(i, 8)
.Cells(i, 10) = "yes"
Case Is = .Cells(i, 8)
If .Cells(i, 4) > .Cells(i, 9) Then
.Cells(i, 10) = "yes"
End If
End Select
End If
End With
Next i
End Sub
I have to re-iterate Siddharth's reference as that will tell you where you need to save this code etc. : http://msdn.microsoft.com/en-us/library/office/ee814737%28v=office.14%29.aspx
Here is a function to compare two dot-notation version numbers which you'd need to paste into a new module in the VBA editor.
Option Explicit
Public Function VersionCompare(CurrentVersion As Range, _
TargetVersion As Range)
Dim result As Integer
result = CompareDotStrings(CurrentVersion.Cells(1, 1).Value, _
TargetVersion.Cells(1, 1).Value)
If result = 1 Then
VersionCompare = True
Else
VersionCompare = False
End If
End Function
Private Function CompareDotStrings(LeftValue As String, _
RightValue As String) _
As Integer
Dim CompareLeft() As String, CompareRight() As String, CompareLength As Integer
CompareLeft = Split(LeftValue, ".")
CompareRight = Split(RightValue, ".")
CompareLength = UBound(CompareLeft)
If UBound(CompareRight) < CompareLength Then CompareLength = UBound(CompareRight)
Dim ElementLeft As Integer, ElementRight As Integer, Comparison As Integer
Dim ElementNumber As Integer
For ElementNumber = 0 To CompareLength
ElementLeft = CInt(CompareLeft(ElementNumber))
ElementRight = CInt(CompareRight(ElementNumber))
Comparison = ElementRight - ElementLeft
If Comparison <> 0 Then
CompareDotStrings = Sgn(Comparison)
Exit Function
End If
Next ElementNumber
CompareDotStrings = 0
End Function
With this you can use =VersionCompare(H2, C2) to compare two version numbers and everything else you want to do (like splitting apart the dashed versions) can be done with formulas in the worksheet.
Related
I am a novice in VBA but recently following #Marcucciboy2, #Cindy Meister and #Mathieu Guindon for their excellent contribution in VBA. In the topic Export VBA Procedures (Sub/Function) Separately I tried a little in guidelines of #Mathieu Guindon and come across a few new problems.
'Public Const vbext_pk_Get As Long = 3
'Public Const vbext_pk_Let As Long = 1
'Public Const vbext_pk_Set As Long = 2
'Public Const vbext_pk_Proc As Long = 0
'sub function
'sub function
Sub test3()
Rw = 15
Dim Vbc As VBComponent
Dim Lno, StLine, LineCnt, CmntPos, ParenthPos As Long
Dim Line, Pname1, Pname2, SubOrFun As String, Pk As vbext_ProcKind
Pk = vbext_pk_Proc
For Each Vbc In ThisWorkbook.VBProject.VBComponents
Lno = 1
Pname1 = ""
For Lno = 1 To Vbc.CodeModule.CountOfLines
Line = Vbc.CodeModule.Lines(Lno, 1)
'For Pk = 0 To 3 **'Activating this For loop cuasing Excel to come to a halt (not responding)'**
Pname2 = Vbc.CodeModule.ProcOfLine(Lno, Pk)
'Filter the line only up to the 1st comment character or 1st parenthesis
'(due to possibility of some parameter name may ends with "sub " or "function ")
CmntPos = InStr(1, Line, "'")
ParenthPos = InStr(1, Line, "(")
If CmntPos > 0 Then Line = Trim(Left(Line, CmntPos - 1))
If ParenthPos > 0 Then Line = Left(Line, ParenthPos - 1)
If Line <> "" And Pname1 <> Pname2 Then
Line = LCase(Replace(Line, Pname2, "")) 'In some cases function name can also contain "sub" like "Batch_subtraction" and vice verse some of the procedures name can be "functionality_View"
SubOrFun = IIf(InStr(1, Line, "function") > 0, "Function", "Sub")
StLine = 0
LineCnt = 0
StLine = Vbc.CodeModule.ProcStartLine(Pname2, Pk) 'Startline including comment lines
LineCnt = Vbc.CodeModule.ProcCountLines(Pname2, Pk) 'line Count including comment lines
Pname1 = Pname2
' sub function
Rw = Rw + 1
' following lines are only for trial/debugging purpose, the results being stored in excel cells
' in actual case here should be the lines of the procedure can be processed by StLine and LineCnt
' Or added to a collection for further processing
ThisWorkbook.Sheets(3).Cells(Rw, 1).Value = Vbc.Name
ThisWorkbook.Sheets(3).Cells(Rw, 2).Value = Pname2
ThisWorkbook.Sheets(3).Cells(Rw, 3).Value = SubOrFun
ThisWorkbook.Sheets(3).Cells(Rw, 4).Value = StLine
ThisWorkbook.Sheets(3).Cells(Rw, 5).Value = LineCnt
ThisWorkbook.Sheets(3).Cells(Rw, 6).Value = Lno
ThisWorkbook.Sheets(3).Cells(Rw, 7).Value = Line
ThisWorkbook.Sheets(3).Cells(Rw, 8).Value = Pk
End If
'Next
Next
Next
End Sub
'sub function
It is working fine.
Now, When I am trying iterate through Pk= 0 to 3 excel is coming to a halt (failing to respond). Also whatever is the value of Pk finally in Excel it is showing as 0. What may be the catch? This is purely due to academic purpose.
Pname2 = Vbc.CodeModule.ProcOfLine(Lno, Pk)
Usage of ProcOfLine is awkward, because the ProcKind parameter isn't just passed ByRef because ByRef is the default in VBA: the ProcKind parameter is passed ByRef because the ProcKind enum value is an output of the function!
Dim Pk As vbext_ProcKind
Pname2 = Vbc.CodeModule.ProcOfLine(Lno, Pk)
Debug.Print Pk ' <~ that's the ProcKind of procedure Pname2 which Lno belongs to
The signature looks like this:
Property Get ProcOfLine(Line As Long, ProcKind As vbext_ProcKind) As String
Its usage might have been clearer if it were like this:
Property Get ProcOfLine(ByVal Line As Long, ByRef outProcKind As vbext_ProcKind) As String
I'm trying to check whether the main string contains the entire substring, even if there are interruptions.
For example:
main string = 12ab34cd,
substring = 1234d
should return a positive, since 1234d is entirely contained in my main string, even though there are extra characters.
Since InStr doesn't take wildcards, I wrote my own VBA using the mid function, which works well if there are extra characters at the start/end, but not with extra characters in the middle.
In the above example, the function I wrote
works if the main string is ab1234dc,
but not if it's 12ab34cd.
Is there a way to accomplish what I'm trying to do using VBA?
Note Both of the methods below are case sensitive. To make them case insensitive, you can either use Ucase (or Lcase) to create phrases with the same case, or you can prefix the routine with the Option Compare Text statement.
Although this can be done with regular expressions, here's a method using Mid and Instr
Option Explicit
Function ssFind(findStr, mainStr) As Boolean
Dim I As Long, J As Long
I = 1: J = 1
Do Until I > Len(findStr)
J = InStr(J, mainStr, Mid(findStr, I, 1))
If J = 0 Then
ssFind = False
Exit Function
End If
I = I + 1: J = J + 1
Loop
ssFind = True
End Function
Actually, you can shorten the code further using Like:
Option Explicit
Function ssFind(findStr, mainStr) As Boolean
Dim I As Long
Dim S As String
For I = 1 To Len(findStr)
S = S & "*" & Mid(findStr, I, 1)
Next I
S = S & "*"
ssFind = mainStr Like S
End Function
Assuming you have 3 columns "SUBSTR","MAIN" and "CHECK" and your "Substring" data range is named "SUBSTR"
Sub check_char()
Dim c As Range
For Each c In Range("SUBSTR")
a = 1
test = ""
For i = 1 To Len(c.Offset(0, 1))
If Mid(c.Offset(0, 1), i, 1) = Mid(c, a, 1) Then
test = test & Mid(c.Offset(0, 1), i, 1)
a = a + 1
End If
Next i
If test = c Then
c.Offset(0, 2) = "MATCH"
Else
c.Offset(0, 2) = "NO MATCH"
End If
Next
End Sub
We have an SQL database that exports to excel. Each record in the database is the evaluation of a project. Each project has a project identifier (string). Since a project can be evaluated two times, each project can have two records. The difference between the two records is the id number (number), with the most recent record having a higher id number. The records are exported to excel with each record as a row in the spread sheet. I am trying to write a sub that compares the two project identifiers and deletes the row with the lower id number. I keep getting an object required error for SameP.
Dim Pident1 As String
Dim Pident2 As String
Dim IdNumb1 As Variant
Dim IdNumb2 As Variant
Dim i As Integer
Dim SameP As Integer
i = 2
For i = 2 To 100
Pident1 = ActiveSheet.Cells(i, 2).Text
Pident2 = ActiveSheet.Cells(i + 1, 2).Text
IdNumb1 = ActiveSheet.Cells(i, 1).Value
IdNumb2 = ActiveSheet.Cells(i + 1, 1).Value
Set SameP = StrComp(Pident1, Pident2, CompareMethod.Text)
If SameP = 0 And IdNumb1> Idnumb2 Then Data.Rows(i).EntireRow.Delete
Next i
End Sub
Any help would be greatly appreciated. I'm not a programmer, i just try when I can. Thanks in advance.
You need to change this
SameP = StrComp(Pident1, Pident2, CompareMethod.Text)
to this:
SameP = StrComp(Pident1, Pident2)
The error is this line also
Data.Rows(i).EntireRow.Delete
Change this to
Sheets("Name_of_sheet_here").Rows(i).EntireRow.Delete
Alternatively this would work too
Activeworksheet.Rows(i).EntireRow.Delete
Change this:
Set SameP = StrComp(Pident1, Pident2, CompareMethod.Text)
If SameP = 0 And IdNumb1> Idnumb2 Then Data.Rows(i).EntireRow.Delete
to
SameP = StrComp(Pident1, Pident2, vbTextCompare )
If SameP = 0 And IdNumb1> Idnumb2 Then ActiveSheet.Rows(i).EntireRow.Delete
So I have 10,000+ Rows of Horrible-unformatted-semi-legible-mumbo-jumbo. I have posted my formulas below. I will run out of space in the formula line shortly, and it's not a very efficient method.
The data looks like this:
SCHMIDT,|JOHN|JACOB|JINGLE-HEIMER|PO|BOX|98765|1234|OCTAVIAN|ST|N|100|MILE|HOUSE|
JIMBOB,|JOEY|JAN|PO|BOX|-|98765|1234|MERCER|RD|E|VANCOUVER|
HEISENBERG,|RR|1|-|98765|1234|FRANKLIN|AVE|S|NORTH|VANCOUVER|
MAN,|HE|98765|1234|SKELETOR|PL|W|100|POCO|
RINGO,|JULIUS|CHARLES|98765|1234|SKELETOR|CRES|NE|100|POCO|
BAJINGO,|DOCTOR|SCRUBS|98765|1234|HOSPITAL|RD|NW|100|EAST|VANCOUVER|
What you see does not exactly always appear in the order that it is in; for example "PO BOX" is absent/present, or at the beginning or the middle or the end of the line. Not all Address_Lines have a Suite number, and not all Suite-Address_Line have a "-" separating the two.
At this point, I want to extract the Direction (N,E,S,W,NE,NW,SE,SW) if any, and the Address_line Suffix (Rd, St, Cres, etc.).
These are my formulas:
Line Suffix =IF(ISNUMBER(SEARCH("|ST|",A2)),"ST",IF(ISNUMBER(SEARCH("|RD|",A2)),"RD",IF(ISNUMBER(SEARCH("|AVE|",A2)),"AVE",IF(ISNUMBER(SEARCH("|PL|",A2)),"PL"))))
Direction =IF(ISNUMBER(SEARCH("|N|",A2)),"N",IF(ISNUMBER(SEARCH("|E|",A2)),"E",IF(ISNUMBER(SEARCH("|S|",A2)),"S",IF(ISNUMBER(SEARCH("|W|",A2)),"W"))))
Can I please get some help rewriting these formulas as two separate functions, in VBA?
My thinking is that I call Search() using a CASE function for the Search_Text on a given cell? I just have no idea to go about this.
I would like to be able to call this function on demand by typing it in a cell on the spreadsheet, by referring to the raw string.
Thanks!
Function FOne(v As Variant) As String
Dim vSearch As Variant, c As Variant
vSearch = Array("|ST|", "|RD|", "|AVE|", "|PL|")
For Each c In vSearch
If InStr(1, v, c) Then
FOne = Mid(c, 2, Len(c) - 2)
Exit Function
End If
Next c
End Function
and
Function FTwo(v As Variant) As String
Dim vSearch As Variant, c As Variant
vSearch = Array("|N|", "|E|", "|S|", "|W|")
For Each c In vSearch
If InStr(1, v, c) Then
FTwo = Mid(c, 2, Len(c) - 2)
Exit Function
End If
Next c
End Function
Try This code as your base, and take from there.
Main sub takes the string in cell(1,1) and extract the direction and address line to cells(1,2) and (1,3) using searchForText function.
You should be able to modify it to fit according to your needs, if not let me know.
Sub Main()
Dim values As Variant
values = Array("|N|", "|E|", "|W|", "|S|", "|NE|", "|NW|", "|SE|", "|SW|")
Cells(1, 2).Value = SearchForText(values)
values = Array("RD", "ST", "CRES") 'fill in the rest of optional values
Cells(1, 3).Value = SearchForText(values)
End Sub
Function SearchForText(values As Variant) As String
Dim line As String
Dim i As Long
Dim j As Integer, k As Integer
line = Cells(1, 1).Value
For k = 0 To UBound(values)
For j = Len(line) To Len(values(k)) + 1 Step -1
If Mid(line, j - Len(values(k)), Len(values(k))) = values(k) Then
GoTo result
End If
Next j
Next k
result:
values(k) = Left(values(k), Len(values(k)) - 1) 'remove vertical lines
values(k) = Right(values(k), Len(values(k)) - 1)
SearchForText = values(k)
End Function
I am having a sheet which contains range of values like "5670&&2","1281&&-3&-5&&7",... etc. in Column A.
Kindly help me to extract the output in VBA in following way:
For E.g 5670&&2 I require A1 cell contains 5670,B1 cell contains &&,C1 cell contains 2.
For E.g 1281&&-3&-5&&7,I would require that A1 cell contains 1281,B1 cell contains &&-,C1 cell contains 3,D1 cell contains &-,E1 cell contains 5,F1 cell contains && and G1 cell contains 7.
Pls help in the same .
Thanks.,
Here i have tried to write code to separate numbers from non-numbers. Numbers and non-numbers are copied to different columns, like Excel Text-To-Columns. Code is a little crazy, if u need i will provide comments. As input the ActiveSheet.UsedRange.Columns(1).Cells is used.
Option Explicit
Sub SeparateNumbers()
Dim targetRange As Range
Dim cellRange As Range
Dim charIndex As Integer
Dim oneChar As String
Dim nextChar As String
Dim start As Integer
Dim copiedCharsCount As Integer
Dim cellValue As String
Dim columnIndex As Integer
Set targetRange = ActiveSheet.UsedRange.Columns(1).Cells
For Each cellRange In targetRange
columnIndex = cellRange.Column
start = 1
copiedCharsCount = 0
cellValue = cellRange.Value
If (VBA.Strings.Len(cellValue) <= 1) Then GoTo nextCell
For charIndex = 2 To Len(cellValue)
oneChar = VBA.Strings.Mid(cellValue, charIndex - 1, 1)
nextChar = VBA.Strings.Mid(cellValue, charIndex, 1)
If VBA.IsNumeric(oneChar) And VBA.IsNumeric(nextChar) Then GoTo nextCharLabel
If Not VBA.IsNumeric(oneChar) And Not VBA.IsNumeric(nextChar) Then GoTo nextCharLabel
cellRange.Offset(0, columnIndex).Value = VBA.Strings.Mid(cellValue, start, charIndex - start)
columnIndex = columnIndex + 1
copiedCharsCount = copiedCharsCount + (charIndex - start)
start = charIndex
nextCharLabel:
If charIndex = Len(cellValue) Then
cellRange.Offset(0, columnIndex).Value = VBA.Strings.Right(cellValue, charIndex - copiedCharsCount)
End If
Next charIndex
nextCell:
Next cellRange
End Sub
Here is one more code. As a side product, function TextSplitToNumbersAndOther can be used independently as a formula to achieve the same effect.
To prevent accidental firing of the macro in a wrong sheet or a wrong column and overwriting neighbouring columns with scrap, named range "Start_point" should be defined by a user. Below this range in the same column, all data will be processed till the first blank row.
Spreadsheet example: http://www.bumpclub.ee/~jyri_r/Excel/Extracting_symbols_into_columns.xls
Option Explicit
Sub ExtractSymbolsIntoColumns()
Dim rng As Range
Dim row_processed As Integer
Dim string_to_split As String
Dim columns_needed As Long
Dim counter As Long
row_processed = 1
counter = 0
Set rng = Range("Start_point")
While rng.Offset(row_processed, 0).Value <> ""
string_to_split = rng.Offset(row_processed, 0).Value
columns_needed = TextSplitToNumbersAndOther(string_to_split)
For counter = 1 To columns_needed
rng.Offset(row_processed, counter).Value = _
TextSplitToNumbersAndOther(string_to_split, counter)
Next
row_processed = row_processed + 1
Wend
End Sub
Function TextSplitToNumbersAndOther(InputText As String, _
Optional SplitPieceNumber As Long) As Variant
Dim piece_from_split(100) As Variant
Dim char_from_input As String
Dim word_count As Long
Dim counter As Long
Dim char_type(100) As Variant
InputText = Trim(InputText)
If Not IsNull(InputText) Then
word_count = 1
piece_from_split(word_count) = ""
For counter = 1 To Len(InputText)
char_from_input = CharFromTextPosition(InputText, counter)
char_type(counter) = CharTypeAsNumber(char_from_input)
If counter = 1 Then
piece_from_split(word_count) = char_from_input
Else
If (char_type(counter - 1) = char_type(counter)) Then
piece_from_split(word_count) = piece_from_split(word_count) & char_from_input
'Merge for the same type
Else
word_count = word_count + 1
piece_from_split(word_count) = char_from_input
End If
End If
Next
End If
If SplitPieceNumber = 0 Then
TextSplitToNumbersAndOther = word_count
Else
If SplitPieceNumber > word_count Then
TextSplitToNumbersAndOther = ""
Else
TextSplitToNumbersAndOther = piece_from_split(SplitPieceNumber)
End If
End If
End Function
Function CharTypeAsNumber(InputChar As String, Optional PositionInString As Long) As Long
If PositionInString = 0 Then PositionInString = 1
If Not IsNull(InputChar) Then
InputChar = Mid(InputChar, PositionInString, 1)
Select Case InputChar
Case 0 To 9
CharTypeAsNumber = 1
Case "a" To "z"
CharTypeAsNumber = 2
Case "A" To "Z"
CharTypeAsNumber = 3
Case Else
CharTypeAsNumber = 4
End Select
Else
CharTypeAsNumber = 0
End If
End Function
Function CharFromTextPosition(InputString As String, TextPosition As Long) As String
CharFromTextPosition = Mid(InputString, TextPosition, 1)
End Function
You can write a UDF (user defined function) to achieve the objective.
Your two example are in an order (ascending) to filter out into adjacent columns in Excel (A, B, C, D...)
So is it correct to assume logically, that you will never have scenarios where you will have to break the string into non-adjacent columns? e.g. 1234 goes to A, && goes to C, 3 goes to D... resulting in A, C, D.
Asumption 2: That your splitted-string is not going to need columns more than Excel can provide.
Steps you may try:
1. Check your string is not empty
2. Split it by the characters other than numerics
3. At the start and end of each non-numeric character you may proceed to the next adjacent column.
search help: Split a string into multiple columns in Excel - VBA