PDA

View Full Version : [SOLVED:] VBA formula not working because array formula needed



KDS14589
09-03-2021, 08:28 AM
I tried posting this question at
https://www.excelforum.com/excel-programming-vba-macros/1357983-vba-formula-not-working-because-array-formula-needed.html but got no response, I'm hoping to do better here.
I hate bothering you people but I'm stuck. I'm spending my retirement time reworking a VERY old and unused excel workbook I made into VBA (& learning it at the same time).
I learned how to take old formulas and by use of macro record paste that new formula into the VBA.
But this formula is array [CSE] and does not work.

=IFERROR(IFERROR(SMALL(IF((COUNTIF($D$9:D9,$B$10:$B$22)=0)*ISNUMBER($B$10:$ B$22),$B$10:$B$22,"A"),1),INDEX($B$10:$B$22,MATCH(SMALL(IF(ISTEXT($B$10:$B$22)*(COUNTIF(D9:$D$9, $B$10:$B$22)=0),COUNTIF($B$10:$B$22,"<"&$B$10:$B$22),""),1),IF(ISTEXT($B$10:$B$22),COUNTIF($B$10:$B$22,"<"&$B$10:$B$22),""),0))),"")

This code does not work. I would list my try/errors but not enough space

FormulaArray = _
"=IFERROR(IFERROR(SMALL(IF((COUNTIF(R9C4:R[-1]C,R10C2:R22C2)=0)*ISNUMBER(R10C2:R22C2),R10C2:R22C2,""A""),1),INDEX(R10C2:R22C2,MATCH(SMALL(IF(ISTEXT(R10C2:R22C2)*(COUNTIF(R[-1]C:R9C4,R10C2:R22C2)=0),COUNTIF(R10C2:R22C2,""<""&R10C2:R22C2),""""),1),IF(ISTEXT(R10C2:R22C2),COUNTIF(R10C2:R22C2,""<""&R10C2:R22C2),""""),0))),"""")"


it gets its data from B10:B22 and is copy/dragged down after CSE in d10:d22
I enter data in the area B25:B37 and then If I choose, I can decide "Yes" in C25:C37 to use it and it will be then transferred into a list in B10:B22 which is then used by that [CSE] formula to remove blanks, duplicates, and then alphabetizes that list. This final list is used in a 'namerange'.
I'm trying to get VBA results I had as with the original worksheet.
I get 'Run Time error 1004 Application-defined or object-defined error'
Please help but in simple, lay-man terms (I'm a VBA newbie, especially when it comes to 'Arrays')

snb
09-03-2021, 09:34 AM
paste that new formula into the VBA

Whiich is a very bad idea.

KDS14589
09-03-2021, 12:13 PM
????

p45cal
09-05-2021, 01:43 PM
Could you attach a workbook with this in and your failing macro code. Don't need all macros, just that/those pertaining to this question as well the sheet (only that sheet you've shown a picture of).
I should be able to get your code right.
Oh, and what version of Excel are you using?

ps. You're probably exceeding the 255 character limit for the likes of:
Range("D10").FormulaArray = …
so will be looking to shorten the formula.

KDS14589
09-06-2021, 07:51 AM
Could you attach a workbook with this in and your failing macro code. Don't need all macros, just that/those pertaining to this question as well the sheet (only that sheet you've shown a picture of).
I should be able to get your code right.
Oh, and what version of Excel are you using?

ps. You're probably exceeding the 255 character limit for the likes of:
Range("D10").FormulaArray = …
so will be looking to shorten the formula.




Sorry I haven't had time to clean the code up.
The macro in question is towards the end, 'commented out'.
Oh ya, I'm using Office 2016 and Windows 10






Sub Worksheet_ShCA02_Activate()


''''Save data and formmulas'''
Dim ArrayOfRanges As Variant
Dim ArrayOfValues As Variant
Dim i As Long

With ThisWorkbook.Sheets("Cards.Lists")
ArrayOfRanges = Array(.Range("B25:C37"), .Range("F25:G37"), .Range("J25:K37"), .Range("N25:O37"), .Range("R25:S37"), .Range("V25:W37"), .Range("Z25:AA37"))
ReDim ArrayOfValues(0 To UBound(ArrayOfRanges))

For i = 0 To UBound(ArrayOfRanges)
ArrayOfValues(i) = ArrayOfRanges(i).Value
Next i

.Cells.SpecialCells(xlCellTypeConstants).ClearContents

For i = 0 To UBound(ArrayOfRanges)
ArrayOfRanges(i).Value = ArrayOfValues(i)
Next i
End With


'''cell color
Cells.Interior.ColorIndex = (ShGE03.Range("O14"))
Range("B25:C37,F25:G37,J25:K37,N25:O37,R25:S37,V25:W37,Z25:AA37").Interior.ColorIndex = (ShGE03.Range("O8")) ''''EDITABLE
Range("B10:B22,F10:F22,J10:J22,N10:N22,R10:R22,V10:V22,Z10:Z22").Interior.ColorIndex = (ShGE03.Range("O9")) ''''NONEDITABLE

'''ColorSheetTab'''
ShCA02.Tab.ColorIndex = (ShGE03.Range("O14"))
'''WIDTH'''
Columns("A").ColumnWidth = 52
Range("B:B,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z,AB:AB").ColumnWidth = 30
Range("C:C,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA").ColumnWidth = 6
Columns("AC:CC").ColumnWidth = 3

'''''''''''FONT''''''''
ShCA02.Cells.Font.Name = "TIMES NEW ROMAN"
ShCA02.Cells.Font.Size = "14"

''''''alignment
Cells.HorizontalAlignment = xlHAlignLeft


'''Cell boarder

Range("B25:C37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("B25:B37, B10:B22,C25:C37").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("D10:D22").BorderAround _
ColorIndex:=3, Weight:=xlThin

Range("F25:G37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("F25:F37,G25:G37,F10:F22").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("H10:H22").BorderAround _
ColorIndex:=3, Weight:=xlThin

Range("J25:K37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("J25:J37,K25:K37,J10:J22").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("L10:L22").BorderAround _
ColorIndex:=3, Weight:=xlThin

Range("N25:O37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("N25:N37,O25:O37,N10:N22").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("P10:P22").BorderAround _
ColorIndex:=3, Weight:=xlThin

Range("R25:S37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("R25:R37,S25:S37,R10:R22").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("T10:T22").BorderAround _
ColorIndex:=3, Weight:=xlThin

Range("V25:W37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("V25:V37,W25:W37,V10:V22").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("X10:X22").BorderAround _
ColorIndex:=3, Weight:=xlThin

Range("Z25:AA37").Borders(xlBottom).LineStyle = XlLineStyle.xlContinuous
Range("Z25:Z37,AA25:AA37,Z10:Z22").BorderAround _
ColorIndex:=0, Weight:=xlThin
Range("AB10:AB22").BorderAround _
ColorIndex:=3, Weight:=xlThin

''ROW
Range("L3").FormulaR1C1 = "=""these are the drop downs needed for the ""&R[1]C[-11]&""_enter_UF' (userform)"""
Range("e24,i24,m24,q24,u24,y24").Value = "Row"
Range("d24,h24,l24,p24,t24,x24,ab24").Value = "#"
Range("E25:E37,I25:I37,M25:M37,Q25:Q37,U25:U37,Y25:Y37").FormulaR1C1 = "=ROWS(R25C3:R[24]C)"
Range("E25:E37,I25:I37,M25:M37,Q25:Q37,U25:U37,Y25:Y37,D25:D37,H25:H37,L25:L37,P25 :P37,T25:T37,X25:X37,AB25:AB37").HorizontalAlignment = xlLeft
'''''''Range("D25:D37,H25:H37,L25:L37,P25:P37,T25:T37,X25:X37,AB25:AB37").FormulaR1C1 = "=ROWS(R25C3:R[0]C)"
''''''''"=IF(AND(R[21]C[-12]=""Yes"",R[21]C[-13]<>""""),R[21]C[-13],"""")"

''''no duplicates no blanks alphabetized

'''''''''Range("D10:D22").FormulaArray =
'''''''' "=IFERROR(IFERROR(SMALL(IF((COUNTIF(R9C4:R[-1]C,R10C2:R22C2)=0)*ISNUMBER(R10C2:R22C2),R10C2:R22C2,""A""),1),INDEX(R10C2:R22C2,MATCH(SMALL(IF(ISTEXT(R10C2:R22C2)*(COUNTIF(R[-1]C:R9C4,R10C2:R22C2)=0),COUNTIF(R10C2:R22C2,""<""&R10C2:R22C2),""""),1),IF(ISTEXT(R10C2:R22C2),COUNTIF(R10C2:R22C2,""<""&R10C2:R22C2),""""),0))),"""")"




Dim counter As Integer
For counter = 1 To 13
Range("d24").Offset(counter, 0).Value = counter
Next counter


'''''''''''''''''''name
ShCA02.Range("A1:A6").Interior.ColorIndex = (ShGE03.Range("O9"))
Range("A1:A25").IndentLevel = 2 ' any integer between 0 and 15
Range("A1:A50").HorizontalAlignment = xlLeft
Range("A2") = Name
Range("A2").NoteText "Worksheet FullName"
Range("A3") = CodeName
Range("A3").NoteText "Worksheet CodeName is used so that if FullName is changed the program will not be affected"
Range("a4") = Left(Range("a2"), (Application.WorksheetFunction.Find(".", Range("a2"), 1) - 1))
Range("a4").NoteText "Is the First part before the separator (.) of the full name and is the Division"

Range("a6") = Mid(Range("a2"), (Application.WorksheetFunction.Find(".", Range("a2"), 1) + 1))
Range("a6").NoteText "Is the Last part after the separator (.) of the full name and is the Purpose"
Range("a5") = "Then the ('.') separator"


End Sub


I'm also attaching a workbook (i hope)

p45cal
09-06-2021, 03:05 PM
Well, that formula is quite clever, but too long for vba's .formulaArray, I was able to shorten it by removing multiple dollar signs (meaning it would be easier to copy across too), but I got bored trying to split it up, and went for a vba approach to filling those ares.
The advantage of retaining formulae in those cells is that when any precedent cells get changed, the result is instantly updated. My vba solution just has plain values. so that bit of code would need running again to update the results.
If you really really want formulae in there I'm prepared to persevere but I'm not guaranteeing I can, nor how quickly!
So here's a snippet of code to deal with all the areas on the sheet that need that treatment:
Sub blah()
For Each are In Range("B25:C37,F25:G37,J25:K37,N25:O37,R25:S37,V25:W37,Z25:AA37").Areas
With are.Offset(-15, 2).Columns(1)
.Value = YesUniqueSorted(are)
.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
End With
Next are
End Sub

along with a function:
Function YesUniqueSorted(myRng)
Set Dict = CreateObject("Scripting.Dictionary")
myVals = myRng.Value
ReDim Results(1 To UBound(myVals), 1 To 1)
idx = 0
For i = 1 To UBound(myVals)
myVals(i, 1) = Application.Trim(myVals(i, 1))
If myVals(i, 2) = "Yes" And Len(myVals(i, 1)) > 0 Then
If Not Dict.Exists(UCase(myVals(i, 1))) Then Dict.Add UCase(myVals(i, 1)), myVals(i, 1)
End If
Next i
idx = 0
For Each itm In Dict.items
idx = idx + 1
Results(idx, 1) = itm
Next itm
YesUniqueSorted = Results
End Function


By the way, if you had Excel 2019 or Office365 you'd be able to avail yourself of the dynamic arrays on the sheet as well as new functions such as FILTER, UNIQUE and SORT.
This means you wouldn't have to array-enter the formula, and the formula would only go in one cell, the formula would be a lot shorter and the results spill out below. Your formula would be:

=SORT(UNIQUE(FILTER(B25:B37,((C25:C37="Yes")*(LEN(TRIM(B25:B37))>0)))))
28942

p45cal
09-06-2021, 05:19 PM
See if this gives the correct answers:
Sub blah2()
Range("D10").FormulaArray = "=IFERROR(INDEX(R10C[-2]:R22C[-2],MATCH(SMALL(IF(((COUNTIF(R10C[-2]:R22C[-2],""<""&R10C[-2]:R22C[-2])>0)*(COUNTIF(R9C:R[-1]C,R10C[-2]:R22C[-2])=0)),COUNTIF(R10C[-2]:R22C[-2],""<""&R10C[-2]:R22C[-2])),1),COUNTIF(R10C[-2]:R22C[-2],""<""&R10C[-2]:R22C[-2]),0)),"""")"
Selection.AutoFill Destination:=Range("D10:D22"), Type:=xlFillDefault
End Sub
or this:
Sub blah3()
For Each cll In Range("D10,H10,L10,P10,T10,X10,AB10").Cells
cll.FormulaArray = "=IFERROR(INDEX(R10C[-2]:R22C[-2],MATCH(SMALL(IF(((COUNTIF(R10C[-2]:R22C[-2],""<""&R10C[-2]:R22C[-2])>0)*(COUNTIF(R9C:R[-1]C,R10C[-2]:R22C[-2])=0)),COUNTIF(R10C[-2]:R22C[-2],""<""&R10C[-2]:R22C[-2])),1),COUNTIF(R10C[-2]:R22C[-2],""<""&R10C[-2]:R22C[-2]),0)),"""")"
cll.AutoFill Destination:=cll.Resize(13), Type:=xlFillDefault
Next cll
End Sub

snb
09-07-2021, 01:05 AM
As soon as you start VBA you should forget almost any Excel function.

In your case this suffices to fill D10 : D22
And it also makes B10 : B22 redundant.

Sub M_snb()
With ShCA02.Range("B25:C37")
.AutoFilter 2, "Yes"
.Columns(1).Copy ShCA02.Cells(10, 4)
.AutoFilter
End With
End Sub

KDS14589
09-07-2021, 06:26 AM
9

KDS14589
09-07-2021, 06:30 AM
WOW p45cal !!! :bug:
Good thing I got someone that knows what their doing.
Give me a few days to try this, I'm busy right now.
But THANKS in advance. I'll let you known how things go. :yes

KDS14589
09-09-2021, 08:44 AM
I finally got some 'me' time and got Office 365 and tried your formula


=SORT(UNIQUE(FILTER(B25:B37,((C25:C37="Yes")*(LEN(TRIM(B25:B37))>0)))))

That makes life simpler.
Thanks for the help