I have a string that is considered a condition and I tried using Evaluate (it works sometimes but not all the time). Have a look at the following example: I got Error 2015
Sub Test()
Dim s As String
Dim result As Variant
On Error Resume Next 'Turn on error handling
's = "7 > ""five""" 'Invalid comparison - expecting a numeric value
s = "((7 > 5) And (10 < 15)) Or (Not (20 = 30))"
result = Evaluate(s)
If Err.Number <> 0 Then 'Check for error
Debug.Print "Error: " & Err.Description
Err.Clear
Else
Debug.Print result 'Output: False
End If
On Error GoTo 0 'Turn off error handling
End Sub
The question posted here too https://eileenslounge.com/viewtopic.php?f=30&t=39654
In my code I will deal with more groups more than 3 and each group will have specific condition and I thought of storing the condition as string like that
Sub Test()
Dim s As String, IGROUP As Long
If IGROUP = 1 Then
s = "a(x, 21) >= 25"
ElseIf IGROUP = 2 Then
s = "a(x, 21) = -1"
ElseIf IGROUP = 3 Then
s = "a(X, 21) <= 25 And a(i, 21) <> -1"
End If
End Sub
This is the whole working code for me
Sub MyTest()
Const IROWS As Long = 20
Dim wb As Workbook, ws As Worksheet, IGROUP As Long, m As Long, i As Long, ii As Long, iii As Long, n As Long
Dim a, e, sAbsent As String, s As String, sHeader As String, j As Long, k As Long, x As Long
Application.ScreenUpdating = False
sAbsent = Chr(34) & Chr(219) & Chr(34)
a = shMY.Range("A2:U" & shMY.Cells(Rows.Count, 1).End(xlUp).Row).Value
For IGROUP = 1 To 3
k = 0: x = 0: n = 0
Set wb = Workbooks.Add(xlWBATWorksheet)
ReDim b(1 To UBound(a, 1), 1 To 11)
For i = LBound(a, 1) To UBound(a, 1)
If IGROUP = 1 Then
s = a(i, 21) >= 25
sHeader = "Group1"
ElseIf IGROUP = 2 Then
s = a(i, 21) = -1
sHeader = "Group2"
ElseIf IGROUP = 3 Then
s = a(i, 21) <= 25 And a(i, 21) <> -1
sHeader = "Group3"
End If
If s Then
k = k + 1: x = 1
b(k, 1) = k
For Each e In Array(2, 6, 3, 8, 9, 10, 12, 13, 14, 21)
x = x + 1
b(k, x) = a(i, e)
Next e
End If
Next i
If k > 0 Then
For i = LBound(b, 1) To UBound(b, 1)
For j = 5 To UBound(b, 2)
If b(i, j) = -1 Then b(i, j) = Chr(219)
Next j
Next i
With ThisWorkbook.Worksheets("Sheet1")
.Range("A8").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
b = Application.Transpose(b)
ReDim Preserve b(1 To UBound(b, 1), 1 To k)
b = Application.Transpose(b)
Dim subArr
subArr = Split2DArray(b, 20)
For i = LBound(subArr) To UBound(subArr)
shNL.Copy After:=wb.Worksheets(wb.Worksheets.Count)
With ActiveSheet
.Range("A5").Value = sHeader
.Range("A8").Resize(UBound(subArr(i), 1), UBound(subArr(i), 2)).Value = subArr(i)
End With
Next i
Application.DisplayAlerts = False
wb.Worksheets(1).Delete
Application.DisplayAlerts = True
wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "\Desktop\" & "RESULT-" & IGROUP & ".pdf"
End If
wb.Close SaveChanges:=False
Next IGROUP
Application.ScreenUpdating = True
End Sub
Function Split2DArray(ByVal a, ByVal IROWS As Long)
Dim subArrays, x As Long, y As Long, i As Long, ii As Long, k As Long
x = UBound(a, 1): y = UBound(a, 2)
ReDim subArrays(1 To Int(x / IROWS) + 1)
For i = 0 To UBound(subArrays) - 1
ReDim subArr(1 To IROWS, 1 To y)
For ii = 1 To IROWS
For k = 1 To y
If (i * IROWS + ii) > x Then
Exit For
Else
subArr(ii, k) = a((i * IROWS) + ii, k)
End If
Next k
Next ii
subArrays(i + 1) = subArr
Next i
Split2DArray = subArrays
End Function
what annoyed me is that I have to test the conditions for each iteration
If IGROUP = 1 Then
s = a(i, 21) >= 25
sHeader = "Group1"
ElseIf IGROUP = 2 Then
s = a(i, 21) = -1
sHeader = "Group2"
ElseIf IGROUP = 3 Then
s = a(i, 21) <= 25 And a(i, 21) <> -1
sHeader = "Group3"
End If
and I still have more groups to work on.
7>5
and10<15
both work but((7>5) And (10<15))
does not (in Excel)