VBA Array problems

[NatWally]

Hi there,

I have been having problems with my arrays in several of my sheets.
The array doesn't seem to hold all the information, and sometimes it also doesn't show the full text I want it to.
I am adding new columns into the sheets, and then changing the vba to match the correct column but it still doesn't seem to work correctly.
I am not sure if the array size is limited or anything which could be causing the problem.
It used to work fine at the start, but of course over time the individual sheets will become more populated with date and so the array may not function correctly.

Unfortunately, I am not exactly sure how to show you as I cannot attached the Excel spre
Please test the macro buttons on sheet 2, 3, 4, and 7 and you will see what I mean. Obviously feel free to investigate the vba code behind them to see why the problem is occurring for all of them.
As I can't attach anything, I am hoping this link works successfully: https://drive.google.com/file/d/1N6sYc5VxVk79MPRRJcG2pLc-JaCheS57/view?usp=sharing

If you need further information on what they are supposed to be doing or anything, please let me know.

Thank you.

 

[JackDanIce]

Welcome to the board.

Your link requires permission to download the spreadsheet and to be honest, that's going to put people off than trying to investigate further.

You can start by posting your code, it may be possible to back-out the reason for arrays now not working, it may be they are wrongly sized initially or unable to capture additional columns.

 

[NatWally]

Hi Jack,

Apologies, I thought I set it to be available to all.

There are four different sheets with a lot of code that I will have to paste in this case.

 

[NatWally]

Is this any better?

Please let me know: https://drive.google.com/file/d/1N6sYc5VxVk79MPRRJcG2pLc-JaCheS57/view?usp=sharing

 

[hiker95]

NatWally,

Welcome to the MrExcel forum.

Your reply #1, and, #4, contain links to your workbook/worksheet(s).

There is a message at your links "To use Docs offline, upgrade to Chrome."


It is always easier to help and test possible solutions if we could work with your actual file

Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com.

Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[JackDanIce]

Hi hiker95,

I was able to download the file from #4 . It's lots of worksheet events in some of the sheets but with varying header rows and it seems like the last column is locked to S, rather than varying further as column count has increased.

Code is generic loops but unclean and limited flexibility (which I think is problem of fixed columns in terms of fixed array problem encountered)

Finally, file is 97-2003 format, suggesting this is a very old file, original coder no-longer available. Implies full rebuild than a quick, couple of code line changes will resolve..

 

[NatWally]

Please try this link: https://www.dropbox.com/s/rtc7ucxibzl04va/SCR as of 17 09 18 - Copy.xlsm?dl=0

Work on Sheet 3.

It uses column S or index 19 to find and use that date.
It gets compared to column A and B (index 1 and 2), along with my custom variable LDiff which calculates the difference in days.

If you read the code you should get an understanding of what each line is meant to be doing and then executing.
It seems to execute and read it fine, it just doesn't seem to fit all of the results into the array box. It must be down to the size of the array and how much it can display, which I am not sure how to make larger.

 

[Fluff]

You are hitting the limit of what you can enter in a msgbox.
Either get rid of some of the boiler plates, or switch to a UserForm.

 

[JackDanIce]

It does seem to be a character string limit. I've separated the msgbox into 3 separate msgbox's plus included a warning if the string length is too big for the msgbox. Line in red is where this test occurs

Replace all of your code in Sheet3 (Support Staff) with following (note sub name change too):

Private Sub SuppSafe_Click()

Expire_New

End Sub

Sub Expire_New()

    Dim arr()       As Variant
    Dim msg(1 To 3) As String
    Dim x           As Long
    Dim dDiff       As Long
    
    With ActiveSheet
        x = .Cells(.Rows.Count, 19).End(xlUp).Row
        arr = .Cells(21, 1).Resize(x - 20, 26).Value
    End With
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        If Len(arr(x, 19)) * Len(arr(x, 1)) * Len(arr(x, 2)) Then
            dDiff = DateDiff("d", Date, arr(x, 19))
            Select Case dDiff
                Case Is < 0: msg(1) = Expired(msg(1), arr(x, 1), arr(x, 2), arr(x, 19))
                Case Is <= 31: msg(2) = Expiring(msg(2), arr(x, 1), arr(x, 2), arr(x, 19), dDiff)
                Case Else: msg(3) = NoTraining(msg(3), arr(x, 1), arr(x, 2), arr(x, 18))
            End Select
        End If
    Next x
    
    For x = LBound(msg) To UBound(msg)
        msg(x) = Replace(msg(x), "@NL", vbCrLf)
        If Len(msg(x)) < 1024 Then
            MsgBox msg(x), vbExclamation, "Safeguarding Certificate Notification"
        Else
            MsgBox "String length for notification too long to fit into this MessageBox", vbExclamation, "Invalid String Length to Display"
        End If
    Next x
    
    Erase arr
    Erase msg
    
End Sub

Private Function Expired(ByRef msg As String, ByRef var1 As Variant, ByRef var2 As Variant, ByRef var3 As Variant) As String

    If Len(msg) = 0 Then msg = "Persons with EXPIRED Safeguading Certificates@NL@NL"
    
    Expired = msg & "(@var3) @var1 @var2@NL"
    Expired = Replace(Expired, "@var1", var1)
    Expired = Replace(Expired, "@var2", var2)
    Expired = Replace(Expired, "@var3", var3)
    
End Function

Private Function Expiring(ByRef msg As String, ByRef var1 As Variant, ByRef var2 As Variant, ByRef var3 As Variant, ByRef d As Long) As String
    
    If Len(msg) = 0 Then msg = "Persons with EXPIRING Safeguarding Certificates@NL@NL"
            
    Expiring = msg & "(@var3) @var1 @var2 (@d days remaining)@NL"
    Expiring = Replace(Expiring, "@var1", var1)
    Expiring = Replace(Expiring, "@var2", var2)
    Expiring = Replace(Expiring, "@var3", var3)
    Expiring = Replace(Expiring, "@d", d)
    
End Function

Private Function NoTraining(ByRef msg As String, ByRef var1 As Variant, ByRef var2 As Variant, ByRef var3 As Variant) As String
    
    If Len(msg) = 0 Then msg = "SAFEGUARDING TRAINING NOT COMPLETED FOR (Start Date)@NL@NL"
            
    NoTraining = msg & "(@var3) @var1 @var2@NL"
    NoTraining = Replace(NoTraining, "@var1", var1)
    NoTraining = Replace(NoTraining, "@var2", var2)
    NoTraining = Replace(NoTraining, "@var3", var3)
    
End Function

 

[NatWally]

Hi Jack,

Thank you for this, it is very much appreciated! - just a couple of things:

I have tried this and it seems to work well for Persons with EXPIRED Safeguading Certificates and Persons with EXPIRING Safeguarding Certificates, but it does not quite work for SAFEGUARDING TRAINING NOT COMPLETED FOR (Start Date).
Currently it does not display (down to the maximum length of the string array).

I increased the length of the string allowed and it didn't quite show what it needed. It currently shows all of those that have safeguarding training that isn't expired or expiring just yet. It would need to show anyone without a date in either column R or S (I forgot to do this in my original version). Basically, it would need to show anyone that does not have a date in either (so missing a date in one of them), or no date in both.

Thank you,