Array formulas and R1C1 VBA

[JoeExcelHelp]

Hi All,

Trying to convert the following formuals into a VBA R1C1 format and I believe the part I'm not doing correct is.. ROWS(R2C1:R2500C1)
Its my first time really using an array formula in VBA so that could also be it. Thank You

{=IFERROR(INDEX($A$2:$A$13, SMALL(IF(ISERROR(MATCH($A$2:$A$13, $C$2:$C$13, 0)), (ROW($A$2:$A$13)-MIN(ROW($A$2:$A$13))+1), ""), ROWS($E$1:E1))),"")}

This is what I did

Sub Test()
With Worksheets("Sheet3").Range("A2:A25000")
Selection.FormulaR1C1 = "IFERROR(INDEX(Sheet1!R2C1:R2500C1,SMALL(IF(ISERROR(MATCH(Sheet1!R2C1:R2500C1,Sheet2!R2C1:R2500C1, 0)), (ROW(Sheet1!R2C1:R2500C1)-MIN(ROW(Sheet1!R2C1:R2500C1))+1), """"), ROWS(R2C1:R2500C1))),"""")"

.Value = .Value
End With
End Sub

[JoeExcelHelp]

Apologies this is the correct VBA Im working with

Sub Test()
With Worksheets("Sheet3").Range("A2:A25000")
Selection.FormulaR1C1 = "IFERROR(INDEX(Sheet1!R2C1:R2500C1,SMALL(IF(ISERROR(MATCH(Sheet1!R2C1:R2500C1,Sheet2!R2C1:R2500C1, 0)), (ROW(Sheet1!R2C1:R2500C1)-MIN(ROW(Sheet1!R2C1:R2500C1))+1), """"), ROWS(R2C1:R2500C1))),"""")"
.FormulaArray = .FormulaR1C1
.Value = .Value
End With
End Sub

[HansV]

If you're using Excel 2019 or earlier, and you want to assign an array formula to a range, you MUST use A1 notation. There is no support for array formulas in R1C1 notation in VBA.

[JoeExcelHelp]

Copy.. its 2016 and Thank You

[JoeExcelHelp]

I have this code which compares 'sheet2' to 'sheet1' and provides all the values missing in 'sheet2' on a seperare sheet called 'missing'
The only issue is its providing me all records missing and I only need unique values

I attached a WB to help better understand

TY

Sub CompareScanToMaster()
Dim ndx As Long
Dim rowsMaster As Long
Dim rowsScan As Long
Dim rngMaster As Range
Dim rngScan As Range
Dim numCount As Long
Dim rng As Range

rowsMaster = ActiveWorkbook.Sheets("sheet1").UsedRange.Rows.Count
Set rngMaster = ActiveWorkbook.Sheets("sheet1").Range("a2:a" & rowsMaster)

rowsScan = ActiveWorkbook.Sheets("sheet2").UsedRange.Rows.Count
Set rngScan = ActiveWorkbook.Sheets("sheet2").Range("a2:a" & rowsScan)


ActiveWorkbook.Sheets("Missing").Range("A2") = "Missing"
numCount = 2

For ndx = 2 To rowsMaster
Set rng = rngScan.Find( _
What:=rngMaster(ndx).Text, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If rng Is Nothing Then
ActiveWorkbook.Sheets("Missing").Cells(numCount, 1) = rngMaster(ndx)
numCount = numCount + 1
End If
Next ndx
End Sub

[HansV]

Simply add another check:

Code: Select all

Sub CompareScanToMaster()
    Dim ndx As Long
    Dim rowsMaster As Long
    Dim rowsScan As Long
    Dim rngMaster As Range
    Dim rngScan As Range
    Dim numCount As Long
    Dim rng As Range
    Dim rng2 As Range
    
    rowsMaster = Sheets("sheet1").UsedRange.Rows.Count
    Set rngMaster = Sheets("sheet1").Range("a2:a" & rowsMaster)
    
    rowsScan = Sheets("sheet2").UsedRange.Rows.Count
    Set rngScan = Sheets("sheet2").Range("a2:a" & rowsScan)
    
    
    Sheets("Missing").Range("A2") = "Missing"
    numCount = 2
    
    For ndx = 2 To rowsMaster
        Set rng = rngScan.Find( _
            What:=rngMaster(ndx).Text, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        If rng Is Nothing Then
            Set rng2 = Sheets("Missing").Range("A:A").Find( _
                What:=rngMaster(ndx), _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            If rng2 Is Nothing Then
                Sheets("Missing").Cells(numCount, 1) = rngMaster(ndx)
                numCount = numCount + 1
            End If
        End If
    Next ndx
End Sub

[JoeExcelHelp]

TY

[snb]

Code: Select all

Sub M_snb()
  sn = Sheet1.Cells(2, 1).CurrentRegion

  With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)
      x0 = .Item(sn(j, 1))
    Next

    sn = Sheet2.Cells(2, 1).CurrentRegion
    For j = 1 To UBound(sn)
      If .exists(sn(j, 1)) Then .Remove sn(j, 1)
    Next

    If .count > 0 Then Sheet7.Cells(1).Resize(.Count) = Application.Transpose(.keys)
  End With
End Sub

[JoeExcelHelp]

Hi Hans,

The code is still populating the name 'francis' on the 'missing' sheet despite his name existing in both sheets 1 and 2

Would is be possible to only consider names in both sheet 1 and 2 if the date is equal to today()?

I added a column field in both sheets (attached)

Thank You

[HansV]

The date column is empty in both sheets...

[JoeExcelHelp]

Hans,

I added the dates and please notice 'francis' is dated 6/23 in that the report should not consider his name on sheet1

Sorry for the missing data

[HansV]

Try this version. Please test carefully.

Code: Select all

Sub CompareScanToMasterv2()
    Dim rng As Range
    Dim rowsMaster As Long
    Dim rowsScan As Long
    Dim rngMaster As Range
    Dim rngScan As Range
    Dim numCount As Long
    Dim sName As String
    Dim rng2 As Range
    
    rowsMaster = Sheets("sheet1").UsedRange.Rows.Count
    Set rngMaster = Sheets("sheet1").Range("a2:a" & rowsMaster)
    
    rowsScan = Sheets("sheet2").UsedRange.Rows.Count
    Set rngScan = Sheets("sheet2").Range("a2:a" & rowsScan)
    
    Sheets("Missing").Range("A:A").ClearContents
    Sheets("Missing").Range("A1") = "Missing"
    numCount = 2
    
    For Each rng In rngMaster
        sName = rng.Value
        If rng.Offset(0, 2).Value = Date Then
            If Application.CountIfs(rngScan, sName, rngScan.Offset(0, 2), Date) = 0 Then
                Set rng2 = Sheets("Missing").Range("A:A").Find( _
                    What:=sName, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
                If rng2 Is Nothing Then
                    Sheets("Missing").Cells(numCount, 1) = sName
                    numCount = numCount + 1
                End If
            End If
        End If
    Next rng
End Sub

[JoeExcelHelp]

Appears to be working great Hans.. I'll do some further testing tomorrow but all looks good Thank You

[snb]

Can you please tell me why you ignored https://eileenslounge.com/viewtopic.php ... 59#p308559 ?