Create various ranges if cell is found or not found in another workbook

Question

I have been struggling for a day and a half with my code. I have a spreadsheet with over 50 columns 18000 rows. I have been able to identify a smaller range of cells in column A defined by "AllEntRg" based on blank cells in column H(OpsCol). I'm stuck with my loops towards the bottom. For EntityRg, I am looping through each cell in "AllEntRg" and if it is Not found in Range CCRg which was defined in BudWb Wk4 Then I want to create a range of all of those cells. The next option, CostCRg, I want to define a range for all cells that ARE FOUND in CCrg.

I have tested this by selecting individual cells and it provides the results I'm looking for but when I have this in the loops I'm getting the following two results: For EntityRg, the range.address defined is the same as AllEntRg (this shouldn't be the case). For CostCRg, I'm getting an error. I'm not sure what I'm not defining correctly. I've been stuck here for quite a while and I have tried using Match Function as well. Again, individually it works but in the loop I'm getting these results which are not expected. I'm interested on the feedback I may receive. Thanks.

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

    Dim wb As Workbook
    Dim BudWkb As Workbook
    Dim Wk2 As Worksheet
    Dim PNLWkb As Workbook
    Dim fpath As String
    Dim fname As String

    Set BudWkb = Workbooks("SubModel Forecast_Other Admin v4.xlsm")
    Set Wk2 = BudWkb.Sheets("By PM")

    fname = "Feb15 PNL"

    'fname = InputBox("Enter PNL File Name")
        Dim Wk4 As Worksheet
        Set Wk4 = BudWkb.Sheets("Validation")

        With Wk4
            Dim CCCol As Long
            Dim fRowCC As Long
            Dim lRowCC As Long
            CCCol = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).Column
            fRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).Offset(1, 0).row
            lRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row
            Dim CCRg As Range
            Set CCRg = Wk4.Range(Wk4.Cells(fRowCC, CCCol), Wk4.Cells(lRowCC, CCCol))
            'MsgBox (CCRg.Address)

        End With



    Set PNLWkb = Workbooks("Feb15 PNL.xlsx")
    Dim Wk1 As Worksheet
    Set Wk1 = PNLWkb.Sheets("det")

    With Wk1

        If Left(Wk2.Name, 5) = "By PM" Then
            Dim OpsCol As Long
            OpsCol = Wk1.Cells.Find("Property Manager", lookat:=xlWhole).Column
        Else
            OpsCol = Wk1.Cells.Find("Submarket", lookat:=xlWhole).Column
        End If

        Dim FRow As Long
        Dim lRow As Long
        Dim ExpCol As Long
        Dim PropCodeCol As Long


        Dim Expense As String
        Expense = InputBox("Enter Expense GL")

        'to locate begining and ending row of data on PNL report
        'Identifies the column where the SubMarket names are located for lookup purposes
        'Defines the expense GL column to lookup based on the inputbox above
        FRow = Wk1.Cells.Find("66990000", lookat:=xlPart).Offset(2, 0).row
        lRow = Wk1.Cells.Find("66990000", lookat:=xlPart).End(xlDown).Offset(-1, 0).row
        ExpCol = Wk1.Cells.Find(Expense, lookat:=xlPart).Column
        PropCodeCol = Wk1.Cells.Find("Property Code", lookat:=xlWhole).Column


        'Defines the Range of the PM or Sub-Market Names
        Dim OpsRg As Range
        Set OpsRg = Wk1.Range(Wk1.Cells(FRow, OpsCol), Wk1.Cells(lRow, OpsCol))

        'Defines the Range of the Property Codes
        Dim PropCodeRg As Range
        Set PropCodeRg = Wk1.Range(Wk1.Cells(FRow, PropCodeCol), Wk1.Cells(lRow, PropCodeCol))

        'Defines the exact range of the expense column being analyzed
        Dim ExpRg As Range
        Set ExpRg = Wk1.Range(Wk1.Cells(FRow, ExpCol), Wk1.Cells(lRow, ExpCol))

    End With

            Dim AllEntRg As Range
            For Each Cell In OpsRg
              If Cell = "" Then
                  If AllEntRg Is Nothing Then
                      Set AllEntRg = Cells(Cell.row, PropCodeCol)
                  Else
                      Set AllEntRg = Union(AllEntRg, Cells(Cell.row, PropCodeCol))
                  End If
                'End If
              End If
            Next
            MsgBox (AllEntRg.Address)

            'MsgBox (Application.Match(Wk1.Cells(59, 1), CCRg, 0))
            'Dim y
            'y = Application.Match(Wk1.Cells(10, 1), CCRg, 0)
            'If IsError(y) Then
            'MsgBox ("pooopy error")
            'End If


            Dim EntityRg As Range
            'Dim c As Range
            For Each c In AllEntRg
            'Dim z
            'z = Application.Match(c, CCRg, 0)


                    If CCRg.Find(c.Value, lookat:=xlPart) Is Nothing Then
                        If EntityRg Is Nothing Then
                            Set EntityRg = c
                        Else
                            Set EntityRg = Union(EntityRg, c)
                        End If
                    End If
            Next
            MsgBox (EntityRg.Address)

            Dim CostCRg As Range
            Dim r As Range
            For Each r In AllEntRg

                    If Not CCRg.Find(r.Value, lookat:=xlPart) Is Nothing Then
                        If CostCRg Is Nothing Then
                            Set CostCRg = r
                        Else
                            Set CostCRg = Union(CostCRg, r)
                        End If
                    End If
            Next
            MsgBox (CostCRg.Address)

            Dim v As Double
            v = Application.WorksheetFunction.Sum(EntityRg)
            'SendKeys "{F9}"
            MsgBox (v)


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Answer 1

I have no means of running your code but I have reviewed it and have noticed some possible problems.

---

lRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row

`.End(xlDown) is not a reliable method of finding the last row of a column. Read this answer of mine for an explanation: Excel vba – xlDown

---

You say: “For EntityRg, the range.address defined is the same as AllEntRg (this shouldn't be the case).”

Do you believe they are the same because EntityRg.Address = AllEntRg.Address?

EntityRg .Address will be a string of absolute cell and range addresses separated by commas. You may not be aware that this string has a maximum length of about 255. I cannot find any documentation but from my own experimentation, EntityRg .Address will be truncated to less than 256 such that there is no partial cell or range address.

Are you being fooled by the first 255 characters of these addresses matching?

Another possibility is that every use of CCRg.Find(c.Value, lookat:=xlPart) returns Nothing so EntityRgand AllEntRg are equal. You say CostCRg gives an error; is this because it is Nothing?

---

You have two loops searching CCRg for values in AllEntRg. One loop records the successes and one records the failures. Why not combine the loops into something like:

If CCRg.Find(c.Value, lookat:=xlPart) Is Nothing Then
  If EntityRg Is Nothing Then
    Set EntityRg = c
   Else
     Set EntityRg = Union(EntityRg, c)
   End If
Else
  If CostCRg Is Nothing Then
    Set CostCRg = r
  Else
    Set CostCRg = Union(CostCRg, r)
 End If
End If

---

I am concerned that For Each c In AllEntRg is not giving you what you expect. If you combine ranges with Union, it will tidy them up. So Union(Range("A2"), Range("A3", Range("A5"), Range("A6"), Range("A7")).Address is "$A$2:$A$3,$A$5:$A$7" not "$A$2,$A$3,$A$5,$A$6,$A$7". My recollection is that For Each c In AllEntRg would not split "$A$2:$A$3" into separate cells.

Please use F8 to step through this loop to check that it is performing as you expect.

Hope this helps

Answer to problem described in comment

Your problem is you are not being consistent in you use of Withs and, in particular, you are not identifying which workbook you want to operate on.

Wk4 is explicitly specified to be within workbook BufdWkb and Wk1 is specified to be within PNLWkb.

However, in

Set AllEntRg = Cells(Cell.row, PropCodeCol)

you do not specify a worksheet or workbook for Cells. This is the equivalent of

Set AllEntRg = ActiveWorkbook.ActiveSheet.Cells(Cell.row, PropCodeCol)`

You need to write Set AllEntRg = .Cells(Cell.row, PropCodeCol) (note period before Cells) and include this code within the With Wk1 Block.