Home > Enterprise >  VBA Excel run macro with IF AND THEN statement in sheet with ListObjects
VBA Excel run macro with IF AND THEN statement in sheet with ListObjects

Time:11-25

I'm trying to run a macro with an IF AND THEN statement in a sheet with ListObjects.

enter image description here

In sheet "CommissionVoice" the macro has to check IF column "L" contains the text values "No Pay" or "Below Target". If it contains these strings then column K (an integer) needs to be calculated with column E (a percentage).

So far I was only able to create the next (Test) code with a simple IF statement but that didn't work:

Sub Test()

    Dim tbl As ListObject
    Dim rng As Range
    Dim cel As Range
    Set tbl = ActiveSheet.ListObjects("CommissionVoice")
    Set rng = tbl.ListColumns(12).DataBodyRange
    
    For Each cel In rng
    If InStr(1, cel.Value, "No pay") > 0 Then
        cel.Offset(0, -1).Value = "OK"
    End If
Next cel

End Sub

Can someone help me with this?

CodePudding user response:

Type mismatch errors can have different causes, for example you cannot assign a string to a number or a number to an object. Usually this error is easy to find using the debugger. Check all involved values/variables of the statement that raises the error.

In this specific case, the command InStr(1, cel.Value, "No pay") is raising the error. The only value that could be of wrong type is cel.Value which represents the value of an actual cell. Now a cell can hold only a numeric value, a string value, a boolean value or an error. Errors are not strings, they are a separate data type. When you see #N/A, this is not the String "#N/A". Those error values cannot be used as and not be converted into any other data type, and therefore you get the type mismatch error.

You can check for errors in VBA with the function IsError. So one could think that the statement should simply be changed into

If Not IsError(cel.Value) And InStr(1, cel.Value, "No pay") > 0 Then

however, that will not solve the issue - VBA will always check all parts of the condition and therefore the InStr-command would be executed anyhow.

2 attempts (there are other)

' 2 separate If-statements
If Not IsError(cel.Value) Then
    If InStr(1, cel.Value, "No pay") > 0 Then
        (...)
    End If
End If

' Store the value into an intermediate variable and change an error to blank
Dim cellValue as Variant
cellValue = cel.Value
If IsError(cellValue) Then cellValue = ""
If InStr(1, cellValue, "No pay") > 0 Then
    (...)
End If

But as already stated in the comments, it is likely it is better to solve this with a formula.

CodePudding user response:

In an Excel Table (ListObject)

enter image description here

Sub Test()

    ' Reference the objects.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' adjust!
    Dim lo As ListObject: Set lo = ws.ListObjects("CommissionVoice")
    
    With lo
        
        ' Get the column indexes.
        Dim colAdj As Long: colAdj = lo.ListColumns("Adjustments").Index
        Dim colNps As Long: colNps = lo.ListColumns("NPS").Index
        Dim colPer As Long: colPer = lo.ListColumns("NPS Performance").Index
        
        With .DataBodyRange ' excluding headers
            
            ' Write the values from the data columns to arrays.
            Dim adjData() As Variant: adjData = .Columns(colAdj).Value
            Dim npsData() As Variant: npsData = .Columns(colNps).Value
            Dim perData() As Variant: perData = .Columns(colPer).Value
            
            Dim r As Long
            
            ' Loop over the rows and modify the values in the arrays.
            For r = 1 To .Rows.Count
                Select Case CStr(perData(r, 1))
                    Case "No pay", "Below Target"
                        ' Maybe some rounding 'nps = Round(nps*(1-adj),2)' ?
                        npsData(r, 1) = npsData(r, 1) * (1 - adjData(r, 1))
                        perData(r, 1) = "OK"
                    'Case Else ' do nothing
                End Select
            Next
            
            ' Write the arrays back to their data columns.
            .Columns(colNps).Value = npsData
            .Columns(colPer).Value = perData
        
        End With
    
    End With

    ' Inform (don't know the jargon).
    MsgBox "Negative commissions applied.", vbInformation

End Sub
  • Related