I had came up with some problem that i not sure on how to compare string.
Example
Dim DateStart as String
Dim CompareDate as String
DateStart = "01-05-15"
In CompareDate i type in a value 02-05-15, how can i compare the 01-05 with 02-05?
I do not want to use Dim DateStart as Date.
And also how can i compare Column instead of Row?
The current code i using for comparing row is :
iRow = ws.Cells.Find(what:="*", After:=ws.Range("a1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
how can i compare the 01-05 with 02-05
Since you are doing a String match, try this
Sub Sample()
Dim DateStart As String
Dim CompareDate As String
CompareDate = "02-05-15"
DateStart = "01-05-15"
If Left(DateStart, (InStrRev(DateStart, "-", -1, vbTextCompare) - 1)) = _
Left(CompareDate, (InStrRev(CompareDate, "-", -1, vbTextCompare) - 1)) Then
MsgBox "Matches"
Else
MsgBox "Doesn't Match"
End If
End Sub
The InStrRev function returns the position of the first occurrence of a string (- in your case) in another string, starting from the end of the string.
Or you could you this simple code
If Left(DateStart, 5) = Left(CompareDate, 5) Then
MsgBox "Matches"
Else
MsgBox "Doesn't Match"
End If
Regarding your second question, I am sorry, I didn't understand what are you trying to achieve. Perhaps if you rephrase it?
Edit: Did you mean you want this SearchOrder:=xlByColumns instead of SearchOrder:=xlByRows
If you won't use "Dim DateStart as Date" maybe you can use "CDate(DateStart)" while comparing.
If you need a specific format you can use (for example):
Format(CDate(DateStart), "dd/mm/yy")
Related
I have a vba code to concatenate a values from different columns. One of the columns; column M - is date, in format dd/mm/yyyy. I would like to concatenate the integer value of date of this with other values in cells.
I am trying to use Int(CDbl("date")) to convert the date value to int, then use that to concatenate with other cells.
My current vba code is:
Dim datevar As Integer
For i = 1 to LastRow
datevar = Int(CDbl(Sheets("Project_Name").Cells(i, 13).value))
target.location.formula = "=Project_Name!B" & i & "&UPPER(Project_Name!D" & i & ")&Project_Name!E" & i & "&Project_Name!F" & i & "&Project_Name!G" & i & "&Project_Name!H" & i & "&Project_Name!I" & i & datevar & ""
Next i
When I run this, I get a "Type Mismatch" error on the datevar = Int(CDb1(...)) line:
Can someone please advise why I am getting an error, and if there is a more efficient way of working?
EDIT
OKay - I get the error as CDbl cannot convert String to Double... However, the value in that cell is definitely a date and not string. What is the best way to counter this issue?
Working with dates, you better store their value to Double and not Integer.
Just use:
datevar = Sheets("Project_Name").Cells(i, 13).Value
You can add the following line to protect against none-integer values:
If IsNumeric(Sheets("Project_Name").Cells(i, 13).Value) And Sheets("Project_Name").Cells(i, 13).Value > 0 Then
Note: you can use Double or Long to store date values.
Integer is limited to values up to 32,767, read HERE.
If we look at today's date, Aug-17-2018 value is 43,329, which is over the Integer upper limit, that's why you are getting your error.
To follow up on our conversation in the comments, heres a quick little example of that idea:
Sub test()
Dim cellValue As String
Dim spaceSpot As Integer
cellValue = CStr(ThisWorkbook.Worksheets(1).Range("A1").Value) ' which is 12/22/2018
spaceSpot = InStr(cellValue, " ")
' Checking if date is in format 12/22/2018 00:00:00
If spaceSpot > 0 Then
cellValue = Left(cellValue, spaceSpot - 1)
End If
cellValue = Replace(cellValue, "/", "")
MsgBox cellValue ' shows 1222018
End Sub
I need to be able to copy cells from one column to another that contain specific characters. In this example they would be ^ and * the characters can be in any order in the cell.
Here is an example :
It looks like I might be able to use the InStr function in VBA to accomplish this if I am not mistaken.
Run a loop for each item in the list and check it with something like the following:
IF InStr(1,Range("A" & i), "^") <> 0 AND InStr(1, Range("A" & i), "*") <> 0 THEN
'copy cell to another place
End If
or might there be a more elegant solution?
I can't see your image form where I am, but Like is generally easier and faster than Instr(). You could try something like this:
If Range("A" & i) Like "*[*^]*[*^]*" Then
meaning you look for some text, then * or a ^, more text, then * or *, more text
For detailed syntax, look here.
Option for no loops - use Arrays and Filter
Option Explicit
Sub MatchCharacters()
Dim src As Variant, tmp As Variant
Dim Character As String, Character2 As String
Character = "*"
Character2 = "^"
' Replace with your sheetname
With Sheet1
src = Application.Transpose(Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)))
tmp = Filter(Filter(src, Character), Character2)
.Range(.Cells(2, 3), .Cells(.Cells(1, 3).End(xlDown).Row, 3)).ClearContents
If UBound(tmp) > -1 Then
With .Cells(2, 3)
Range(.Offset(0, 0), .Offset(UBound(tmp), 0)).Value2 = Application.Transpose(tmp)
End With
End If
End With
End Sub
Or use as a function with unlimited character searching
Public Function MatchCharacters(arr As Variant, ParamArray Characters() As Variant) As Variant
Dim i As Long
For i = LBound(Characters) To UBound(Characters)
arr = Filter(arr, Characters(i))
Next i
MatchCharacters = arr
End Function
Sub test()
Dim tmp As Variant
With Sheet1
tmp = Application.Transpose(Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)))
tmp = MatchCharacters(tmp, "*", "^")
If UBound(tmp) > -1 Then
With .Cells(2, 3)
Range(.Offset(0, 0), .Offset(UBound(tmp), 0)).Value2 = Application.Transpose(tmp)
End With
End If
End With
End Sub
Edit
Looking at this again and being inspired by Tom's answer about filtering, it got be thinking... the AdvancedFilter can do exactly what you're looking to do. It's designed into the spreadsheet side of Excel, but you can use it from VBA.
If you only want to work out of VBA, or if your filter won't be changing often, then this probably is not your best choice... but if you want something that's more visible and flexible from the workbook side of things, this would be a good choice.
To manually run Advanced Filter...
Example code and dynamic filter scenario...
(Notice you can use equations with it)
Sub RunCopyFilter()
Dim CriteriaCorner As Integer
CriteriaCorner = Application.WorksheetFunction.Max( _
Range("B11").End(xlUp).Row, _
Range("C11").End(xlUp).Row, _
Range("D11").End(xlUp).Row)
[A4:A10].AdvancedFilter xlFilterCopy, Range("B4:D" & CriteriaCorner), [E4:E10], True
End Sub
Named Ranges
AdvancedFitler automatically creates NamedRanges for it's criteria and output. That can be handy because you can reference the NamedRange as Extract and it will dynamically update.
Original Post
Here's some code for a "tolerant" InStr() function from a similar post I made... it isn't tailored exactly to your example, but it gets at the basic point of character-by-character analysis.
Function InStrTolerant(InputString As String, MatchString As String, Optional CaseInsensitiveChoice = False, Optional Tolerance As Integer = 0) As Integer
'Similar to InStr, but allows for a tolerance in matching
Dim ApxStr As String 'Approximate String to Construct
Dim j As Integer 'Match string index
j = 1
Dim Strikes As Integer
Dim FoundIdx As Integer
For i = 1 To Len(InputString)
'We can exit early if a match has been found
If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
InStrTolerant = FoundIdx
Exit Function
End If
If StringsMatch(Mid(InputString, i, 1), Mid(MatchString, j, 1), CaseInsensitiveChoice) Then
'This character matches, continue constructing
ApxStr = ApxStr + Mid(InputString, i, 1)
j = j + 1
FoundIdx = i
Else
'This character doesn't match
'Substitute with matching value and continue constructing
ApxStr = ApxStr + Mid(MatchString, j, 1)
j = j + 1
'Since it didn't match, take a strike
Strikes = Strikes + 1
End If
If Strikes > Tolerance Then
'Strikes exceed tolerance, reset contruction
ApxStr = ""
j = 1
Strikes = 0
i = i - Tolerance
End If
Next
If StringsMatch(ApxStr, MatchString, CaseInsensitiveChoice) Then
InStrTolerant = FoundIdx
Else
InStrTolerant = 0
End If
End Function
Also, I always feel obliged to mention Regex in these cases. Although it isn't the easiest to use, especially with VBA, it is designed exactly for powerful complex matching.
The below code is working fine with me. I need your help and support to make it a function so I can for example write in any cell
=adj() or =adj(A1) and the formula will apply,
Sub adj()
Dim i, j As Integer
Sheet1.Select
With Sheet1
j = Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, -2)).Value
For i = 1 To j
ActiveCell.Formula = "=" & Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It's hard for me to definitively understand what you're trying to do here. I think you're trying to concatenate x number of cells with a separator field.
So, I would do the following changes... obviously you can change accordingly.
Declare the Inputs as variants. If you don't and get a type mismatch the function wont call in debug. This also gives you the opportunity to deal with the Inputs.
Put in an error handler to prevent unwanted debug w.r.t. a failure.
You can't use Evaluate that way. I think you're trying to get an Evaluation of cells like A1 etc.
The function has to be called from a Cell on a sheet since it uses Application.Caller. You shouldn't really need this for the function to work, but I put in in there in case you are calling via F9 calculation.
You can also put in the line if you want the calculation to occur every time you recalculate. However this should be used with caution since you can get some unwanted calculation side effects with some spreadsheets when using this.
Application.Volatile
Public Function Adj(ByVal x As Variant, ByVal y As Variant) As String
On Error GoTo ErrHandler
Dim sSeparator As String, sCol As String
Dim i As Integer
'Get the column reference.
sCol = Split(Columns(y).Address(False, False), ":")(1)
'Activate the sheet.
Application.Caller.Parent.Select
sSeparator = Chr(10)
For i = 1 To x
Adj = Adj & Evaluate(sCol & i) & sSeparator
Next
'Remove the last seperator...
Adj = Left(Adj, Len(Adj) - 1)
Exit Function
ErrHandler:
'Maybe do something with the error return value message here..
'Although this is a string, Excel will implicitly convert to an error.
Adj = "#VALUE!"
End Function
If you wanted to pass change to a formula, and pass in the range, you would use something like:
Public Function Func(Byval MyRange as range) as variant
In this case, you're not specifying a return value so it will be ignored.
Public Function Func(Byval MyRange as range) as variant
Dim i, j As Integer
With MyRange.parent
j = .Range(MyRange.Offset(0, -2), MyRange.Offset(0, -2)).Value
For i = 1 To j
MyRange.Formula = "=" & .Range(MyRange.Offset(0, -1), MyRange.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It would be something like that..
I am using VBA to make date filters. This filter will take the dates I specify in sheet 1 to and filter the column I have selected at the moment. Ideally, I would like to have all the values with the date in that range PLUS all blanks (where no date has been defined).
Set rep= ActiveWorkbook.Sheets("sheet2")
Set sh1 = ActiveWorkbook.Sheets("Sheet1")
Dim anf As String
Dim ende As String
Dim count As Integer
anf = ">=" + sh1.Range("J2")
ende = "<=" + sh1.Range("J3")
rep.Select
count = Range(Selection, Selection.End(xlToLeft)).Columns.count
rep.Range("$A$4:$GD$11668").AutoFilter Field:=count, Criteria1:=anf, Operator:=xlAnd, Criteria2:=ende, Operator _
:=xlFilterValues
This code functions beautifully. However, it only filters the date. My attempts to add blanks as well (in addition to it) have failed.
For example, adding a 3rd criterion for blanks:
rep.Range("$A$4:$GD$11668").AutoFilter Field:=count, Criteria1:=anf, Operator:=xlAnd, Criteria2:=ende, Operator:=xlAnd, Criteria3:="=", Operator _
:=xlFilterValues
I get an application defined or object defined error.
Any ideas? Thanks!
You can't do more than 3 criteria at the same time that way -if you notice in the user interface you can only get 2 "and" or whatever criteria at the same time.
However, you can do an array and set that as criteria. Refer to this example
Try the following example
Sub Sample()
Dim SampleRange As Range
Dim ArrayDates(2) As Date
ArrayDates(0) = "1-1-2017"
ArrayDates(1) = "1-2-2017"
ArrayDates(2) = Now()
'1st approach, add the array directly in the criteria
Set SampleRange = Range("A1:A31")
SampleRange.AutoFilter Field:=1, Operator:= _
xlFilterValues, Criteria1:=Array(2, "1/1/2017", 2, "1/2/2017", 2, "1/3/2017")
'2nd approach: define an array and just start to call it as needed
SampleRange.AutoFilter Field:=1, Operator:= _
xlFilterValues, Criteria1:=Array(ArrayDates(1))
End Sub
First off, your error was caused by trying to give Autofilter 3 criteria - it can only handle 2, and it had no idea what to do with the extra arguments you passed it.
Now, that's not the only problem with what you're trying. Notice that if you attempt to filter between two dates manually through the UI, you can do it, but you can't also add blanks. It's kind of a one-thing-or-the-other situation. I also tried Brian's solution at first, but Excel just doesn't work that way. At least, I couldn't coax it into working that way.
This leaves us with two very ugly possible solutions. Either you modify the table you're filtering (add an extra column with a formula or something along those lines) to give Autofilter something else to filter on, or manually set all the valid criteria. Here's how you do the latter:
Private Sub setFilter()
Set rep = ActiveWorkbook.Sheets("sheet2")
Set sh1 = ActiveWorkbook.Sheets("Sheet1")
Dim anf As String
Dim ende As String
Dim count As Integer
anf = sh1.Range("J2")
ende = sh1.Range("J3")
rep.Select
count = Range(Selection, Selection.End(xlToLeft)).Columns.count
rep.Range("$A$4:$GD$11668").AutoFilter Field:=count, Criteria1:=GetValidDates(CDate(anf), CDate(ende)), Operator:=xlFilterValues
End Sub
Private Function GetValidDates(ByVal startD As Date, ByVal endD As Date) As String()
Dim numDays As Integer: numDays = endD - startD + 1
Dim dateArray() As String
ReDim dateArray(numDays) ' (numDays + 1) entries
Dim i As Integer
For i = 0 To numDays - 1
dateArray(i) = CStr(startD + i)
Next
dateArray(i) = ""
GetValidDates = dateArray
End Function
This builds an array of all dates between and including the start and end (as well as an extra empty "" entry to allow blanks). It's ugly and I'm not sure how well it'll work for really big date ranges (might be slow), but at least Excel recognizes and accepts it.
I couldn't follow what you were trying to do, but maybe something like this:
Sub test1()
Dim rep As Worksheet
Dim sh1 As Worksheet
Set rep = ActiveWorkbook.Sheets("sheet4")
Set sh1 = ActiveWorkbook.Sheets("Sheet3")
Dim i As Long
Dim count As Integer
Dim arr As Variant
arr = Array("=" & """""", ">=" & sh1.Range("J2"), "<=" & sh1.Range("J3"))
rep.Select
count = Range(Selection, Selection.End(xlToLeft)).Columns.count
For i = 0 To UBound(arr)
rep.Range("$A$4:$GD$11668").AutoFilter Field:=count, Criteria1:=arr(i)
Next i
End Sub
I want to search for a string that ends with a number but it is not known before what number it will be
So I'm using the InStr function
InStr(Range("B" & row).Value), "text")
But now the problem is, what i'm searching for can be "text0", "text1", "text9", I don't want to create 10 times a Instr function to test al the 10 numbers.
What I'm looking for is a replacement character like you have # that stands for any given number in a input mask in Acces. So something like this
InStr(Range("B" & row).Value), "text" & #)
offcoarse this will not work as excel will take this as search for "text#" and wil not interpretate it as # is any given number.
Edit:
Range("B" & row).Value will evaluate for example to "9S 279P3NOV/PDE NN1 PRS NO NVML"
What i need to know is where NN1 is so I can extract it.
But the next row can evaluate to "9S 2793NOV/PE NN12 REQ BANA"
So again I need to know where NN12 is, also notice the text before NN12 changes and that NN now has 2 digits.
After reading the comments below the question
the number is random, the actual string i'm looking for always start with NN so the found string can be NN1, NN5 or actualy even NN25. There is no way in telling before what the number will be.
Is this what you are trying? Use the LIKE with wildcards.
Try this
Sub Sample()
Dim stringToTest(1 To 5) As String
Dim i As Long
stringToTest(1) = "Test01"
stringToTest(2) = "Test01Test"
stringToTest(3) = "123"
stringToTest(4) = "01Test01"
stringToTest(5) = "NNature1234"
For i = 1 To 5
If stringToTest(i) Like "NN*#" Then Debug.Print stringToTest(i)
Next i
End Sub
Followup from comments / recent edit to the question
If you format is going to as you have shown in the question, i.e there will be spaces then try this
Sub Sample()
Dim s As String, stringToTest(1 To 2) As String
Dim ar
Dim i As Long, j As Long
stringToTest(1) = "9S 279P3NOV/PDE NN1 PRS NO NVML"
stringToTest(2) = "9S 2793NOV/PE NN12 REQ BANA"
For i = 1 To 2
s = stringToTest(i)
If s Like "*NN*#*" And InStr(1, s, " ") Then
ar = Split(s, " ")
For j = LBound(ar) To UBound(ar)
If ar(j) Like "NN*#" Then
Debug.Print ar(j)
Exit For
End If
Next j
End If
Next i
End Sub
Output
NN1
NN12
If I understood correctly, simple looping could help:
Sub SearchNum()
Dim i As Integer
Dim strSource As String
Dim boolNumFound As Boolean
'Found flag
numFound = False
'Put source string to variable
'(put here your range address)
strSource = Range("B1").Value
'Loop through your number range
For i = 0 To 99
If InStr(1, strSource, "text" & i) Then
numFound = True
MsgBox "text" & i
Exit For
End If
Next i
End Sub
I had a similar issue yesterday. I took the answer given to me and edited it to fit your issue, but I can't take 100% credit :-p. I believe this will get you what you're looking for.
sub test()
Dim sWords() As String
Dim s As Variant
Dim sResult As String
sWords = Split(ActiveCell.Value, " ")
For Each s In sWords
If Left$(s, 2) = "NN" Then
sResult = sResult & s
msgbox sResult
sResult = ""
End if
Next s
end sub
Could this function work for you?
If IsNumeric(Right(Range("B" & row).Value, 1)) Then
MsgBox "It ends with a Number."
Else
MsgBox "It does not end with a Number."
End If
I think this will run a bit faster than the other solutions provided.
This is case-insensitive as written but removing the vbTextCompare would make it case-sensitive. I've tested this, the code works.
Function nnNumeric(ByVal textIn As String, Optional ByVal startPos As Long = 1) As Long
'searches textIn for NN followed by a number; e.g. NN0, NN1, NN2, etc.
'returns the position when found, otherwise returns #VALUE! error
Dim i As Long
i = InStr(startPos, textIn, "NN", vbTextCompare) 'remove vbTextCompare to make this case-sensitive
Do While i > 0
If IsNumeric(Mid(textIn, i + 2, 1)) Then
nnNumeric = i
Exit Function
End If
i = InStr(i + 1, textIn, "NN", vbTextCompare) 'remove vbTextCompare to make this case-sensitive
Loop
nnNumeric = CVErr(xlErrValue) '#VALUE! error
End Function