Differentiate between "1" and "11"

user_18986520 0
Viewed 89

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.

vba excel
4 Answers

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.

user_42791550

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
user_165784240

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
user_71773460

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
user_98140690
Related