Convert multiple Countifs formulas referring to other worksheets, to VBA code

[Saltysteve]

Hi,

Any help with the following will be most appreciated.

In Sheet 2 I have the following formula starting at H5 down to H85. The formula counts how many inspections an inspector does between specified start and end dates.

=COUNTIFS(SHEET1!$E:$E,$E5,SHEET1!$A:$A,">="&IF($A5="",$G$2,IF($A5>$G$2,$A5,$G$2)),SHEET1!$A:$A,"<="&IF($B5="",$H$2, IF($B5<$H$2,$B5,$H$2)),SHEET1!$D:$D,"="&H$3)+COUNTIFS(SHEET1!$E:$E,$F5,SHEET1!$A:$A, ">="&IF($A5="",$G$2,IF($A5>$G$2,$A5,$G$2)),SHEET1!$A:$A,"<="&IF($B5="",$H$2,IF($B5<$H$2,$B5,$H$2)),SHEET1!$D:$D,"="&H$3)

Sheet 1 cells (raw data) are as follows: A – Dates, D – Inspection codes (4 different codes), E – Email addresses

Sheet 2 cells are as follows: E5: E85 – inspector’s primary email addresses (different inspector in each cell, also needs to be noted that the list needs to be able to grow), F5:F85 – inspector’s secondary email address, G2 – start date, H2 - end date, H3 – Inspection code

The same formula is actually in ranges H5:K85, AB5:AE85 and AP5:AS85. The other columns in each range covers the other inspection codes and the dates in each range change. ie – current month, previous month, year to date

This is the formula in AR85 for some clarity:

=COUNTIFS(SHEET1!$E:$E,$E85,SHEET1!$A:$A,">="&IF($A85="",$AO$2,IF($A85>$AO$2,$A85,$AO$2)),SHEET1!$A:$A,"<="&IF($B85="",$AP$2,IF($B85<$AP$2,$B85,$AP$2)),SHEET1!$D:$D,"="&AR$3)+COUNTIFS(SHEET1!$E:$E,$F85,SHEET1!$A:$A,">="&IF($A85="",$AO$2,IF($A85>$AO$2,$A85,$AO$2)),SHEET1!$A:$A,"<="&IF($B85="",$AP$2,IF($B85<$AP$2,$B85,$AP$2)),SHEET1!$D:$D,"="&AR$3)

With the raw data that gets updated regularly and all of these formulas (there are actually many many more), i'm sure you could appreciate how large the workbook is and how it tests my poor computers power, needless to say, it is very slow to recalculate.

I would like to convert this all to VBA to get rid of all of the formulas and possibly have it refer to another workbook for the raw data. Although if that would slow the execution of the code too much, I can continue to pull it into this workbook.

 

[mse330]

Hey Saltysteve,

Since you've provided just a formula it was very difficult to write a script that does what you need. Try the below code in a copy of your file & see if it works. I suggest that you upload a sample file online (Dropbox for example) & share a link with us to work on other requests

PS: I don't know about your data setup but is it possible that same row in sheet2 could have 2 identical emails in columns E & F ? Because your formula will count the record twice whereas I have adjusted my code to count the record once

Sub updateCount()

Dim a, b, sDate&, eDate&, iCode$
a = Sheets("Sheet1").[A1].CurrentRegion '<-- ensure sheet name is correct

With Sheets("Sheet2") '<-- ensure sheet name is correct
    b = .Range("A5:H" & .UsedRange.Rows.Count)
    sDate = .[G2]: eDate = .[H2]: iCode = .[H3]
    For x = 1 To UBound(b)
        If IsEmpty(b(x, 1)) Or b(x, 1) <= sDate Then b(x, 1) = sDate
        If IsEmpty(b(x, 2)) Or b(x, 2) >= eDate Then b(x, 2) = eDate
        b(x, 8) = 0
        For i = 2 To UBound(a)
            If a(i, 4) = iCode And (a(i, 5) = b(x, 5) Or a(i, 5) = b(x, 6)) _
             And a(i, 1) >= b(x, 1) And a(i, 1) <= b(x, 2) Then b(x, 8) = b(x, 8) + 1
        Next
    Next
    .[H5].Resize(UBound(b)) = Application.Index(b, 0, 8)
End With

End Sub

 

[Saltysteve]

Hey MSE330,

Thanks for the code, it's so very neat and works pretty well although a few conditions from my formula are not included. I'm pretty sure I can add them in and I also think I will be able to incorporate the other ranges so it is basically doing what I wanted. Understand the difficulty of not seeing the spreadsheet, sorry for making it hard for you but it contains a lot of sensitive data that I am not able to share. Nevertheless, you have done the job, well done.

To get it past this line - sDate = .[G2]: eDate = .[H2]: iCode = .[H3] - I had to remove the dots.

Thanks again for the very quick reply.

 

[mse330]

Glad you were able to figure out adjusting the code to suite your needs

In case you need further help, you don't have to share the actual data but a mock file with dummy data that is representative & we're happy to help & thanks for reporting back

 

[Saltysteve]

Ok thank you,

I didn't respond to your question about the possibility that the same row in Sheet2 could have 2 identical emails in columns E & F. That is not possible, as our domain name changed, hence the 2 email addresses and column E has the original email address and 'F' the new. The raw data has both addresses, but never for the same inspection, but as the report generated (another part of the workbook) includes what happened last year at the same time, I need to get both and the start and end dates determine which inspections get counted.

Also just realised I didn't explain the references to column A and B in Sheet2. These are dates when inspectors start or finish in a particular factory. They move around so I need to be able to allocate their inspections to the correct factory. If they move, a new row is created in the range that covers the factory they have moved to (somewhere within the list, currently between row 5 and 85) and column A has the date they stopped at the old factory and column B the date they start at the new. If they leave the company, their departure date is added to column B. This is why the list of inspectors needs to grow, inspectors that leave can be removed after 1 year, but their inspections still get added for the previous year. If they aren't removed, it doesn't affect the count (as long as their departure date is included in column B). They eventually get deleted provided at least 1 year has passed since their departure date.

I guess this is pretty confusing without seeing the actual sheet!

If you want to try anything else i can make a very short version that has dummy data. If you are interested in staying wit h it, let me know.

 

[Saltysteve]

Hey mse330,

Thought I was capable, apparently not, all I have tried does not help me and I think is totally the wrong way to approach this. Your code was pretty much perfect and all I had to do was correct for the fact the cases for some email addresses vary between upper and lower. Fixed that very easily and apart from the dots I mentioned previously, your code worked perfectly.
I have shifted some columns around for the dummy file but this is the code as it stands:

Sub updateCount()

Dim a, b, sDate&, eDate&, iCode$

a = Sheets("Sheet1").[A2].CurrentRegion

With Sheets("Sheet2")
b = .Range("A5:G" & .UsedRange.Rows.Count)

For x = 1 To UBound(b)
sDate = [G2]
eDate = [H2]
iCode = [G3]

If IsEmpty(b(x, 1)) Or b(x, 1) <= sDate Then b(x, 1) = sDate
If IsEmpty(b(x, 2)) Or b(x, 2) >= eDate Then b(x, 2) = eDate
b(x, 7) = 0
For i = 2 To UBound(a)
If a(i, 2) = iCode And (UCase(a(i, 3)) = UCase(b(x, 4)) Or UCase(a(i, 3)) = UCase(b(x, 5))) _
And a(i, 1) >= b(x, 1) And a(i, 1) <= b(x, 2) Then b(x, 7) = b(x, 7) + 1

Next
Next
.[G5].Resize(UBound(b)) = Application.Index(b, 0, 7)

End With

End Sub

So my difficulty now is that same code needs to also be applied to the subsequent columns in each range. The start and end dates, in row 2 are the same within each range and the iCode changes to the corresponding column (ie. INSPMED in the 1st range is column H, INSPLGE is column I), then similar pattern for the next 2 ranges of 'Previous Month' and 'Same Time Previous Year'. The start and end dates, when inspectors move around (columns A and B in Sheet 2) apply in all of the calculations.

I only have a free dropbox account and it looks like you can only view this file, so I'm not sure if it is any good to you and I doubt you can see the code - Mr Excel Dummy File . If this doesn't work I can do it through Sharepoint (I think).

Hope you are still on board and look forward to your reply.

Cheers

 

[mse330]

Hello Hey Saltysteve,

I am able to download the file ... In your original post, you've stated that you have 4 different inspection codes whereas the sample file you shared with us only has 3. Also, do you want this operation/macro to loop across all columns in sheet2 with just different dates & inspection codes ? Is there any other data in between or that's repeated across all columns ?

 

[mse330]

Hello again,

I have worked on the code & made some variables so you can change 1 place instead of messing in many parts of the code to weather you have 3 or 4 inspector codes & in which column your data starts from for the visit counts

You can see the file I worked on HERE ... Give the below code a try & let me know how it goes … I have inserted 1 more sheet to validate the VBA code against your formula in post #1

Sub updateCountDummy()

Dim a, b, c, sDate&, eDate&, iCode$, CodeCnt&, StartCol&, DatesAr

a = Sheets("Sheet1").[A1].CurrentRegion
b = Sheets("Sheet2").UsedRange
DatesAr = Sheets("Sheet2").Range("A1:B" & Sheets("Sheet2").UsedRange.Rows.Count)
    
CodeCnt = 3  'Change this as per how many codes you have per section
StartCol = 7 'Count to start filling from column G (7th column)

ReDim c(1 To UBound(b), 1 To UBound(b, 2))
For x = StartCol To UBound(b, 2) - CodeCnt + 1
    
    'This is to identify the date location based on # of number of codes per section
    If (x - (StartCol - 1)) Mod CodeCnt = 1 Then sDate = b(2, x)
    If (x - (StartCol - 1)) Mod CodeCnt = 1 Then eDate = b(2, x + 1)
    
    For k = 0 To CodeCnt - 1
        iCode = b(3, k + x)
        
        For j = 5 To UBound(b)
        
        'Reset dates for next section count
            b(j, 1) = DatesAr(j, 1)
            b(j, 2) = DatesAr(j, 2)
            
            If IsEmpty(b(j, 1)) Or b(j, 1) <= sDate Then b(j, 1) = sDate
            If IsEmpty(b(j, 2)) Or b(j, 2) >= eDate Then b(j, 2) = eDate
            c(j - 4, k + x - (StartCol - 1)) = 0
                For i = 2 To UBound(a)
                    If a(i, 2) = iCode And (UCase(a(i, 3)) = UCase(b(j, 4)) Or UCase(a(i, 3)) = UCase(b(j, 5))) _
                     And a(i, 1) >= b(j, 1) And a(i, 1) <= b(j, 2) Then
                        c(j - 4, k + x - (StartCol - 1)) = c(j - 4, k + x - (StartCol - 1)) + 1
                    End If
                Next i
        Next j
    Next k
Next x
  
Sheets("Sheet2").Cells(5, StartCol).Resize(UBound(c), UBound(c, 2)) = c
  
End Sub

 

[Saltysteve]

Hey mse330,

You are a legend. The code you have written is so elegant and written to easily make it grow with time.

Sorry for the confusion with code numbers. There are actually 4, I'm just a bit time poor at present so got lazy.

I can't thank you enough.

Stay healthy in these crazy times.

 

[mse330]

Glad to help, I tired as much as I could to make it usable with minimum changes required from your end

Stafy safe