What I have here is a tracking list, for feeding pumps. We have to account for stock levels, so I made this. When you enter a pump, into the table, nothing happens. When you put a patient's name against it, the row goes pink to indicate the pump has left our stock.
I was trying to get a script/macro together that could count the pumps that we still had (i.e the white rows, e column), and display the list (table will get quite long in future) to the user.
My code:
It loops through the c column (serial numbers) for each "cll", an if statement checks if there is anything in the cell 2 columns to the right (patient name, if there is a patient name, it means the pump has been given out) AND if there is a value in the e column (serial numbers). It displays serial numbers that fulfill the criteria in a series of message boxes.
The code works, and I'm happy to roll it out, as this isn't an overly important issue, and I'll be leaving it with a group of technophobes. However, I'm wondering, it's a little clunky?
I don't like the seperate message boxes, but I can't find any info on making an array in excel VBA, and I don't like checking the IF using the offset property.
I couldn't make checking the cll.Interior.color/colorIndex work, as excel seemed to think the cells are all the same color, regardless of what color they actually are. (?conditional formatting causing issues).
Hope this makes sense,
EDIT:
Code as text:
Private Sub CommandButton1_Click()
Dim cll As Range
For Each cll In Range("c6:c200")
If IsEmpty(cll.Offset(0, 2)) And cll.Value > 0 Then
MsgBox "Pump Serial number: " & vbNewLine & vbNewLine & cll.Value
End If
Next cll
End Sub
concatenate the serial numbers in the loop and then after the loop show the concatenated string.
find the last cell with a value and only loop to that row.
Iterate a variant array instead of the range, it is quicker
Private Sub CommandButton1_Click()
Dim cll As Variant
cll = ActiveSheet.Range("C6", ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(, 2)).Value
Dim str As String
str = ""
Dim delim As String
delim = ""
Dim i As Long
For i = 1 To UBound(cll, 1)
If Not IsEmpty(cll(i, 1)) And IsEmpty(cll(i, 3)) Then
str = str & delim & cll(i, 1)
If delim = "" Then delim = vbNewLine
End If
Next i
MsgBox "Pump Serial number: " & vbNewLine & vbNewLine & str
End Sub
Related
I have 20 cases. For every row in my sheet, I have a cell that assigns related case numbers to it. A row could have multiple case numbers assigned to it in that cell (Example: 1,2,11,12)
I am writing a code to copy all the rows that have Case number 1 assigned to them, copy them someplace else..
and then go to case number 2 and repeat the same..
This is what I am using:
For CaseNumbers = 1 To 20
For i = Row1 To RowLast
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
COPY AND PASTE CODE
End If
Next
Next
The problem I am facing is, the code considers case number 11 as case number 1 too (since it has the digit 1).
This is the first time I am writing a VBA code and I have no background in this.
Can someone please advise on better way of doing this? Should I assign a checklist instead to each row?
All I want to do is find all the rows that have Case number 1 assigned, copy them.. then find all the rows that have Case 2 assigned, copy them.. and so on.
Please help.
You can use a function to do the test
Public Function isCaseNumberIncluded(ByVal caseToCheck As Long, ByVal caseNumbers As String) As Boolean
'add , to make all values distinct
caseNumbers = "," & caseNumbers & ","
Dim strCaseToCheck As String
strCaseToCheck = "," & caseToCheck & ","
If InStr(1, caseNumbers, strCaseToCheck) > 0 Then
isCaseNumberIncluded = True
End If
End Function
You would call this function within your main code like this:
Dim caseNumber As Long 'I removed the s - as this could be misleading in my eyes
For caseNumber = 1 To 20
For i = Row1 To RowLast
If isCaseNumberIncluded(caseNumber, Range(CaseNoCell & i).Value) Then
COPY AND PASTE CODE
End If
Next
Next
Using a separate function to run the test has two advantages:
your code gets more readable, ie you know from reading the functions name what the result should be - without reading the whole code how to do it :-)
you can re-use this code propably at another place
Or you can test the function first:
Public Sub test_isCaseNumberIncluded()
Debug.Print isCaseNumberIncluded(1, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(1, "2,11,12"), "Should be false"
Debug.Print isCaseNumberIncluded(11, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(11, "1,2,12"), "Should be false"
End Sub
Well, you are working with this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
This checks against 1,, 12,, ..., but obviously it won't cover the last entry so that's something you'll need to add. And you have the problem that 11, gets treated as 1,.
In a similar way you can use this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, "," & CaseNumbers & ",") Then
This checks against ,1,, ,12,, ... so it will solve your error, but obviously it won't cover the last and the first entry so that's something you'll need to add.
This is something that should be encapsulated in a function rather than being done in line. The method provided in VBA for tokenising a string is 'Split'.
You could wite a function that checks tokens 1 by 1, or which compile a collection of the tokens which then uses a built checking method of the collection to determine if the specified token is present or not.
In this specific case I've chosen to use the collection method. The specific object for the collection is the ArrayList (but a Scripting.Dictionary is also possible). The function contains checks for zero length strings and allows the seperator to be specified if it isn't a comma.
Option Explicit
Function FindToken(ByVal ipToken As String, ByVal ipTokenList As String, Optional ByVal ipSeparator As String = ",") As Boolean
' Guard against ipSeparator being vbnullstring
Dim mySeparator As String
mySeparator = IIf(VBA.Len(ipSeparator) = 0, ",", ipSeparator)
'Raise an error if ipToken or ipTokenList are empty strings
If VBA.Len(ipToken) = 0 Or VBA.Len(ipTokenList) = 0 Then
Err.Raise 17, "Empty string error"
End If
'Convert the token list to tokens
Dim myTokens As Variant
myTokens = VBA.Split(ipTokenList, mySeparator)
' Put the tokens in an ArrayList so we can use the contains method
' no point is doing early binding as arraylist doesn't provide intellisense
Dim myAL As Object
Set myAL = CreateObject("System.Collections.ArrayList")
Dim myItem As Variant
For Each myItem In myTokens
' Trim just in case there are spaces
myAL.Add VBA.Trim(myItem)
Next
'Finally test if the Token exists in the token list
Find = myAL.contains(VBA.Trim(ipToken))
End Function
This means that your code
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
can now be rewritten as
If FindToken(CStr(CaseNUmbers), Range(CaseNoCell & cstr(i)).Value) Then
Identify Criteria Rows
Option Explicit
Sub Test()
Const WordSeparator As String = ","
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim CaseNumber As Long
Dim i As Long
Dim cValue As Variant
Dim cString() As String
For CaseNumber = 1 To 20
For i = Row1 To RowLast
cValue = CStr(ws.Range(CaseNoCell & i).Value)
If Len(cValue) > 0 Then
cString = Split(cValue, WordSeparator)
If IsNumeric(Application.Match( _
CStr(CaseNumber), cString, 0)) Then
' CopyAndPasteCode CaseNumber
Debug.Print "Case " & CaseNumber & ": " & "Row " & i
End If
End If
Next i
Next CaseNumber
End Sub
I have an excel file with four columns: name, surname, address, area.
There are a lot of rows.
Is there a way to concatenate all the values of every single row in a variable, using vba?
I need a variable that should contain something like this:
(name1, surname1, address1, area1); (name2, surname2, address2, area2); (name3, surname3, address3, area3)...
If you have the following data in your worksheet
Then the following code will read the data into an array …
Option Explicit
Public Sub Example()
Dim RangeData() As Variant ' declare an array
RangeData = Range("A1:D5").Value2 ' read data into array
End Sub
… with the following structure:
Alternatively you can do something like
Public Sub Example()
Dim DataRange As Range
Set DataRange = Range("A2:D5")
Dim RetVal As String
Dim Row As Range
For Each Row In DataRange.Rows
RetVal = RetVal & "(" & Join(Application.Transpose(Application.Transpose(Row.Value2)), ",") & "); "
Next Row
Debug.Print RetVal
End Sub
To get this output:
(name1, surname1, address1, area1); (name2, surname2, address2, area2); (name3, surname3, address3, area3); (name4, surname4, address4, area4);
.. is there a way to write the result like a sort of list that shows all the values of the cells of the range?
Yes, there is. In addition to PEH's valid answers and disposing of Excel version MS365 you might also use
Dim s as String
s = Evaluate("ArrayToText(A2:D5, 1)") ' arg. value 1 representing strict format
resulting in the following output string:
{"name1","surname1","address1","area1";"name2","surname2","address2","area2";"name3","surname3","address3","area3";"name4","surname4","address4","area4"}
Syntax
ARRAYTOTEXT(array, [format])
The ARRAYTOTEXT function returns an array of text values from any specified range. It passes text values unchanged, and converts non-text values to text.
The format argument has two values, 0 (concise default format) and 1 (strict format to be used here to distinguish different rows, too):
Strict format, i.e. value 1 includes escape characters and row delimiters. Generates a string that can be parsed when entered into the formula bar. Encapsulates returned strings in quotes except for Booleans, Numbers and Errors.
Thank you for your answers, suggestions, ideas and hints. I am sorry if my question was not so clear, all the solutions you added were perfect and extremely elegant.
In the end I found a way - a dumber way in comparison to all the things you wrote - and I solved with a for statement.
I did like this:
totRow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To totRow
name = Cells(i, 1)
surname = Cells(i, 2)
address = Cells(i, 3)
area = Cells(i, 4)
Example = Example & "(" & name & ", " & surname & ", " & address & ", " & area & "); "
Next i
Range("E1").Value = Example
It works (it does what I wanted to do), but I noticed a little limit: if the rows are a lot I can't keep the whole text in the variable.
I need to generate lot numbers for my products and since my software doesn't auto generate them, I have defined a logic in Excel for the same. It is quite basic and combines data in 2 or more cells to create a unique code.
To be more specific, I shall introduce our operations to you. We have a few collection centers for our products and we require them to apply lot number labels onto their bags of coffee before transferring it to our main warehouse. I have created an excel sheet in which I enter the current date in one cell and select the name of the center in another which then generates a lot number for the same. For example, cell A1 has today's date and A2 has center 'MBR' selected. The formula in cell C2 =IF(A2="MBR","MB:"&TEXT(A1,"YYYYMMDD")&"-001",IF(A2="MAY","AY:"&TEXT(A1,"YYYYMMDD")&"-001",IF(A2="MZM","MM:"&TEXT(A1,"YYYYMMDD")&"-001",""))) shall give me a result as MB:20171010-001
Now comes the tricky part. I want to mention in cell A3 the number of lots to be generated. For example, if I say I want 10 labels, then the formula should give me 10 labels from "-001" to "-010." If possible, it could start with the number which I would define in possibly cell A4 and then give me the sequence as required.
Lastly, I use this info to generate barcodes using an add-on in excel which I downloaded from the internet which converts the text into barcodes and then I can print them. I have tried barcode fonts but they don't work at all. If you have another alternative to this where I could generate sequential lot numbers based on the logic defined and create barcodes for the same, please share it with me. If not, please give me a formula which will work with excel.
Enter your data in columns A - C, run the bit of sample code below, result is in column D. You can modify the code to suit your needs but here is a start for you:
Public Sub RunTags()
Dim oWS As Worksheet
Dim lRow As Long
Dim lNextTagRow As Long
Set oWS = Worksheets("Sheet1")
lRow = 2
lNextTagRow = 2
Do Until oWS.Range("A" & lRow) = ""
Select Case oWS.Range("A" & lRow)
Case "MBR"
PrintTags oWS, lNextTagRow, "MB:", oWS.Range("B" & lRow), oWS.Range("C" & lRow)
Case "MAY"
PrintTags oWS, lNextTagRow, "MA:", oWS.Range("B" & lRow), oWS.Range("C" & lRow)
Case "MZM"
PrintTags oWS, lNextTagRow, "MZ:", oWS.Range("B" & lRow), oWS.Range("C" & lRow)
End Select
lRow = lRow + 1
Loop
End Sub
.
Private Sub PrintTags(ByRef oWS As Worksheet, ByRef lTagRowStart As Long, sPrefix As String, lQty As Long, lStart As Long)
Dim x As Long
Dim dtNow As Date
dtNow = Now()
For x = lStart To lStart + lQty - 1
oWS.Range("D" & lTagRowStart) = sPrefix & Format(dtNow, "YYYYMMDD") & "-" & Format(x, "000")
lTagRowStart = lTagRowStart + 1
Next x
End Sub
I need to parse out a list of tracking numbers from text in excel. The position in terms of characters will not always be the same. An example:
Location ID 987
Your package is arriving 01/01/2015
Fruit Snacks 706970554628
<http://www.fedex. com/Tracking?tracknumbers=706970554628>
Olive Oil 709970554631
<http://www.fedex. com/Tracking?tracknumbers=709970554631>
Sign 706970594642
<http://www.fedex .com/Tracking?tracknumbers=706970594642>
Thank you for shopping with us!
The chunk of text is located in one cell. I would like the results to either be 3 separate columns or rows looking like this:
706970554628 , 709970554631 , 706970594642
There will not always be the same number of tracking numbers. One cell might have six while another has one.
Thank you for any help!!
I think you'll need some VBA to do this. And it's not going to be super simple stuff. #Gary'sStudent has a great example of grabbing numbers from a big string. If you need something that is more specific to your scenario you'll have to parse the string word by word and have it figure out when it encounters a tracking number in the URL.
Something like the following will do the trick:
Function getTrackingNumber(bigMessage As String, numberPosition As Integer) As String
Dim intStrPos As Integer
Dim arrTrackNumbers() As Variant
'create a variable to hold characters we'll use to identify words
Dim strWorkSeparators As String
strWordSeparators = "()=/<>?. " & vbCrLf
'iterate through each character in the big message
For intStrPos = 1 To Len(bigMessage)
'Identify distinct words
If InStr(1, strWordSeparators, Mid(bigMessage, intStrPos, 1)) > 1 Then 'we found the start of a new word
'if foundTrackNumber is true, then this must be a tracking number. Add it to the array of tracking numbers
If foundTrackNumber Then
'keep track of how many we've found
trackNumbersFound = trackNumbersFound + 1
'redim the array in which we are holding the track numbers
ReDim Preserve arrTrackNumbers(0 To trackNumbersFound - 1)
'add the track
arrTrackNumbers(trackNumbersFound - 1) = strword
End If
'Check to see if the word that we just grabbed is "tracknumber"
If strword = "tracknumbers" Then
foundTrackNumber = True
Else
foundTrackNumber = False
End If
'set this back to nothing
strword = ""
Else
strword = strword + Mid(bigMessage, intStrPos, 1)
End If
Next intStrPos
'return the requested tracking number if it exists.
If numberPosition > UBound(arrTrackNumbers) + 1 Then
getTrackingNumber = ""
Else
getTrackingNumber = arrTrackNumbers(numberPosition - 1)
End If
End Function
This is a UDF, so you can use it in your worksheet as a formula with:
=getTrackingNumber(A1, 1)
Which will return the first tracking number it encounters in cell A1. Consequently the formula
=getTrackingNumber(A1, 2)
will return the second tracking number, and so on.
This is not going to be a speedy function though since it's parsing the big string character by character and making decisions as it goes. If you can wrangle Gary's Student's answer into something workable it'll be much faster and less CPU intensive on larger data. However, if you are getting too many results and need to go at this like a surgeon, then this should get you in the ballpark.
If tracking is always a 12 digit number, then select the cell run run this short macro:
Sub parser117()
Dim s As String, ary, i As Long
With ActiveCell
ary = Split(Replace(Replace(.Text, Chr(10), " "), Chr(13), " "), " ")
i = 1
For Each a In ary
If Len(a) = 12 And IsNumeric(a) Then
.Offset(0, i).Value = a
i = i + 1
End If
Next a
End With
End Sub
I want to use the .find function in VBA to find instances of a value in a column, however there are calculations which are made based on criteria on the same rows as where the value is found. This is problematic because although the value I am looking for might be the same, the criteria which are used to create the overall score are different. As a result, I would need to loop through all the values which are found in the column and I was wondering how to do that in vba. I know the findnext function but I can never get it to work properly.
counted = Application.WorksheetFunction.CountIfs(cl.Range(finletter & "9:" & finletter & "317"), "Value", cl.Range("H9:H317"), wl.Range("A" & y.row).Value)
'Pol small low complex
If counted > 0 Then
MsgBox wl.Range("A" & y.row).Value
If cl.Range("C" & y.row).Value < 3 And cl.Range("D" & y.row).Value = 1 And cl.Range("E" & y.row).Value = "Interim" Then
wl.Range(y.Address) = 3.75 * counted
Here is an example. Say we are looking for the text "LOVE" in column A and process the data on those rows:
Option Base 1
Sub LookingForLove()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "LOVE"
Set rng = Range("A1:A25")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Loop
msg = UBound(WhichRows) & vbCrLf & vbCrLf
For i = 1 To UBound(WhichRows)
msg = msg & WhichRows(i) & vbCrLf
Next i
MsgBox msg
End Sub
NOTE:
the Exit Do prevents looping forever
your code would continue by looping the elements of WhichRows() and processing the items on those rows.
your code could alternatively create a dynamic array of ranges or cell addresses.
Another alternative approach would be to use VBA to establish an AutoFilter and process the visible rows.