I'm having an issue that I feel should be fairly simple but turns out I can't get it to work. I'm sure it's something that I am doing but I need your expert help. I'm simply cycling through a datatable and checking to see if a value shows up again in a different column of the datatable. For some reason BOTH statements are firing and the else statement is overwriting the If statement.
For i = 0 To length - 1
For j = 0 To length - 1
If Trim(dt.Rows(i)(0)) = Trim(dt.Rows(j)(6)) Then
need_dt.Rows(i)(9) = "COMP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -5), "MM/dd/yy")
Else
need_dt.Rows(i)(9) = "TOP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -16), "MM/dd/yy")
End If
If Year(need_dt.Rows(i)(10)) = 2029 Then need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(Now, 14), "MM/dd/yyyy")
Next
Next
The else statement will be executed on all rows that aren't found. You need to keep the result in a variable and do the action you want at the end. Since the other If statement doesn't use j, you don't need to do it on every j.
For i = 0 To length - 1
Dim isFound As Boolean = False
For j = 0 To length - 1
If Trim(dt.Rows(i)(0)) = Trim(dt.Rows(j)(6)) Then
isFound = True
Exit For
End If
Next
If isFound Then
need_dt.Rows(i)(9) = "COMP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -5), "MM/dd/yy")
Else
need_dt.Rows(i)(9) = "TOP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -16), "MM/dd/yy")
End If
If Year(need_dt.Rows(i)(10)) = 2029 Then need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(Now, 14), "MM/dd/yyyy")
Next
As I understand you want set column number 9 = "COMP" if value of column 0 exists in column 6 of any row.
In this case your problem is -> if last value of column 6 in last row is not equal to value of column 1 - value of column 9 will be overwritten with "TOP"
In your code you need exit from loop after you find equal value.
But I suggest to use little bid more readable approach
For Each row As DataRow in need_dt.Rows
Dim firstColumnValue As String = row.Field(Of String)("0ColumnName").Trim()
Dim is6ColumnContainValue As Func(Of DataRow, Boolean) =
Function(dtRow) dtRow.Field(Of String)("6ColumnName").Trim() = firstColumnValue
Dim isValueFound = need_dt.AsEnumerable().Any(is6ColumnContainValue)
Dim tenthColumnValue AS Date = row.Field(Of Date)("10ColumnName")
Dim workingDaysToAdd As Integer
If IsValueFound = True Then
row.SetField("9ColumnName", "COMP")
workingDaysToAdd = -5
Else
row.SetField("9ColumnName", "COMP")
workingDaysToAdd = -16
End If
If TenthColumnValue.Year = 2029 Then
tenthColumnValue = resource.AddWorkingDays(Date.Now, 14)
Else
tenthColumnValue = resource.AddWorkingDays(tenthColumnValue, workingDaysToAdd)
End If
row.SetField("10ColumnName", tenthColumnValue)
Next
Also suggest to set Option Strict On which give compile time feedback about possible type conversion errors
Related
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
so I thought this would be a simple logical problem, but for the life of me I cannot find the issue with this code block. I have checked around on Stack for a solution, but all other do/while loop problems appear to be primarily with other languages.
What I am trying to do is simply loop through an array & add a new worksheet for each element in the array that is not null. Pretty simple right? Yet for some reason it simply loops through once and thats it.
Here is the code block:
Dim repNames() As String
Dim x As Integer
x = 25
ReDim repNames(1 To x)
repNames(1) = "Ahern"
repNames(2) = "Castronovo"
repNames(3) = "Glick"
repNames(4) = "Fields"
repNames(5) = "Murphy"
repNames(6) = "Sleeter"
repNames(7) = "Vivian"
repNames(8) = "Walschot"
repNames(9) = "Wilson"
Dim i As Integer
i = 1
Do 'Loop keeps creating only 1 new sheet. Should create 9.
Worksheets.Add.Name = repNames(i)
i = i + 2
Loop While repNames(i) <> Null
I believe the problem is with this line: Loop While repNames(i) <> Null,
but obviously the logical test seems to hold up.
Any help would be hugely appreciated!
As others note, Null is not the comparison you want to make. Testing anything for equivalence with Null will return Null -- even ?Null = Null returns Null, which is why your loop is exiting early. (Note: To test for a Null, you need to use the IsNull function which returns a boolean, but that is NOT how you test for an empty string.)
In VBA, to test for a zero-length string or empty string, you can use either "" or vbNullString constant, or some people use the Len function to check for zero-length.
Rectifying that error, as originally written in your code, your logical test should abort the loop if any item is an empty string, but none of the items are empty strings (at least not in the example data you've provided) so you end up with an infinite loop which will error once i exceeds the number of items in the repNames array.
This would be probably better suited as a For Each loop.
Dim rep as Variant
For Each rep in repNames
Worksheets.Add.Name = rep
Next
If you need to skip empty values, or duplicate values, you can add that logic as needed within the loop:
For Each rep in repNames
If rep <> vbNullString 'only process non-zero-length strings
Worksheets.Add.name = rep
End If
Next
Etc.
Firstly, you should be comparing to vbNullString. This loops multiple times:
' Declare variables
Dim repNames() As String
Dim x As Integer
Dim i As Integer
' Set data
x = 25
ReDim repNames(1 To x)
repNames(1) = "Ahern"
repNames(2) = "Castronovo"
repNames(3) = "Glick"
repNames(4) = "Fields"
repNames(5) = "Murphy"
repNames(6) = "Sleeter"
repNames(7) = "Vivian"
repNames(8) = "Walschot"
repNames(9) = "Wilson"
' Loop through items
i = 1
Do
Worksheets.Add.Name = repNames(i)
i = i + 2
Loop While repNames(i) <> vbNullString
There is one more problem – why i = i + 2 ? In your question you say you wanted the loop to execute 9 times, but using i = i + 2 skips every other item. If you indeed want to loop through every item:
Do
Worksheets.Add.Name = repNames(i)
i = i + 1
Loop While repNames(i) <> vbNullString
Here you go, I have changed the loop conditional, and changed i=i+2 to i=i+1. A regular while loop would be better than a do while encase the first element is empty
Dim repNames()
Dim x As Integer
x = 25
ReDim repNames(1 To x)
repNames(1) = "Ahern"
repNames(2) = "Castronovo"
repNames(3) = "Glick"
repNames(4) = "Fields"
repNames(5) = "Murphy"
repNames(6) = "Sleeter"
repNames(7) = "Vivian"
repNames(8) = "Walschot"
repNames(9) = "Wilson"
Dim i As Integer
i = 1
Do While repNames(i) <> ""
Worksheets.Add.Name = repNames(i)
i = i + 1
Loop
I have a simple function that is going to pull from a specific Cell (N4). If there are cells below it then it will loop and collect all the content of the cell and separate with comma.
I'm getting #VALUE! error in excel right now and I kind of know where my issue lies but can not figure how to fix it, since I am not that proficient with excel-vba code. I think the issue is with ActiveSheet.Range("N4").Value and the offset part.
I am not sure how to offset then select the value in the text then add it to my string Value.
Any thought on how I can select the content of cell and add to string variable and doing the same when you offset?
Here is my code:
Function pullshit() As String
Dim output As String
Dim counter As Integer
counter = 1
output = ActiveSheet.Range("N4").Value
If Application.offset(N4, counter, 0).Value = "" Then
pullshit = output
Else
While counter <> 0
output = output + ", " + Application.offset(N4, counter, 0).Value
counter = counter + 1
If Application.offset(N4, counter, 0) = "" Then
counter = 0
End If
Wend
pullshit = output
End If
End Function
Offset use is wrong. Try this.
Function pullshit() As String
Dim output As String
Dim counter As Integer
counter = 1
output = ActiveSheet.Range("N4").Value
If Range("N4").Offset(counter, 0).Value = "" Then
pullshit = output
Else
While counter <> 0
output = output + ", " + Range("N4").Offset(counter, 0).Value
counter = counter + 1
If Range("N4").Offset(counter, 0) = "" Then
counter = 0
End If
Wend
pullshit = output
End If
End Function
Use of the function in a screenshot
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.
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