Worksheet Display Not Updating Through Loop Process

[Ark68]

Consider this code below:

Sub cheese()
    'Stop
    r = 6
    For lp = sdate To Edate
        t_mon = Format(lp, "mmm")
        t_day = Format(lp, "dd")
        t_dayy = Format(lp, "ddd")
        tar_str = t_mon & "-" & t_day & " (" & t_dayy & ") Schedule_*"
        srcfile = tar_str
        
        Debug.Print lp & "  " & Format(lp, "dd-mmm-yy")
        
        strFileName = srcpath & srcfile
        strFileExists = Dir(strFileName)
        
        If strFileExists = "" Then
            'MsgBox "No data file found for:  " & Format(lp, "dd-mmm-yy")
            With ws_front
                With .Cells(r, 2)
                    .Value = Format(lp, "dd-mmm-yy")
                    .BorderAround LineStyle:=xlcontnuous, Weight:=xlThin
                End With
                r = r + 1
            End With
            
            'Stop
        Else
            'Stop
            import
            
        End If
        
        'pop_col
            
    Next lp
    If r > 0 Then
        ui1 = MsgBox(r & " dates of empty data." & Chr(13) & "Do you wish to view them?", vbYesNo, "MISSING DATES")
        If ui1 = vbYes Then
            ws_temp4.Visible = xlSheetVisible
        End If
    End If
    
End Sub

This code steps between a range of two dates (sdate and edate), 149 dates are in this range. lp represents the respective individual date between the two parameters. In the loop, it refers to a directory to see if a data file (.xlsx) exists for that date represented by lp. If it does, it proceeds to execute the next procedure (import). If not, the value of 'lp' is recorded on the main worksheet ("FRONT") representing a date that does not exist in the directory.

The worksheet "FRONT" has an interface to display the progress of the application.

Book1
	B	C	D	E	F
2	148	149		RECORDS
3	DATE			Date	Cuml.
4	20-Oct-19			2	5024
5	Missing Dates
6	11-Oct-19
7	14-Oct-19
FRONT

In the 'import' procedure, I have code that is supposed to update these cells (highlighted in blue) accordingly based on the data provided from that code. For instance, as the code steps through each date, and counts the number of records etc, the interface will update with the date and number of records associated with that date file it's working with. I would expect then to see the date, for example, increment as each successive date is processed. But ... its not. It loads the first set of data and stays as is despite the code stepping through the dates until the procedure ends. When it ends, is when the cells of the interface update next.

Sub import()
    'Stop
    
    Set wb_srcbook = Workbooks.Open(Filename:=srcpath & strFileExists, ReadOnly:=True)
    Set ws_srcdata = wb_srcbook.Worksheets("DATA")
    wb_srcbook.Windows(1).Visible = False
    
    'source data
    With ws_srcdata
        src_lrow = .Cells(Rows.Count, 1).End(xlUp).Row
        src_rowcnt = src_lrow - 1
    End With
    'target data
    With ws_tardata
        tar_lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        tar_rowcnt = tar_lrow - 1
        tar_dest = tar_lrow + 1
    End With
    
    With ws_front
        .Range("B4") = ws_srcdata.Range("B2")
        .Range("B2") = .Range("B2") + 1
        'dtof = Days
        .Range("E4") = src_rowcnt
        .Range("F4") = tar_rowcnt + src_rowcnt
    End With
    
    Application.ScreenUpdating = False
    'data transfer
    'range 1 (A:F)
    ws_srcdata.Range("A2:F" & src_lrow).Copy
    ws_tardata.Range("G" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 2 (G)
    ws_srcdata.Range("G2:G" & src_lrow).Copy
    ws_tardata.Range("N" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 3 (H:I)
    ws_srcdata.Range("H2:I" & src_lrow).Copy
    ws_tardata.Range("P" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 4 (J:O)
    ws_srcdata.Range("J2:O" & src_lrow).Copy
    ws_tardata.Range("S" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 5 (P:U)
    ws_srcdata.Range("P2:U" & src_lrow).Copy
    ws_tardata.Range("AA" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 6 (W:AD)
    ws_srcdata.Range("W2:AD" & src_lrow).Copy
    ws_tardata.Range("AG" & tar_dest).PasteSpecial Paste:=xlPasteValues
    
    'save target
    'wb_main.Save
    
    'close source (without saving)
    Application.DisplayAlerts = False
    wb_srcbook.Close
    Application.DisplayAlerts = True

End Sub

Is anyone able to suggest why this is not providing the display results I am hoping to achieve?

 

[RoryA]

Probably because the Import procedure turns screenupdating off and doesn't turn it back on, so you'll only get an update when all the code has finished.

 

[jmacleary]

Hi there. You have a line
Application.ScreenUpdating = False
in your import routine. After the first execution of it, screenupdating will be off. Either remove that line, or insert Application.ScreenUpdating = True before your blue section.

 

[Ark68]

Ahhh ... ok. That would do it ... thank you both!

I changed my code ...

Sub import()
    'Stop
    
    Set wb_srcbook = Workbooks.Open(Filename:=srcpath & strFileExists, ReadOnly:=True)
    Set ws_srcdata = wb_srcbook.Worksheets("DATA")
    wb_srcbook.Windows(1).Visible = False
    
    'source data
    With ws_srcdata
        src_lrow = .Cells(Rows.Count, 1).End(xlUp).Row
        src_rowcnt = src_lrow - 1
    End With
    'target data
    With ws_tardata
        tar_lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        tar_rowcnt = tar_lrow - 1
        tar_dest = tar_lrow + 1
    End With
    
    With ws_front
        .Range("B4").Value = ws_srcdata.Range("B2")
        .Range("B2").Value = .Range("B2").Value + 1
        'dtof = Days
        .Range("E4").Value = src_rowcnt
        .Range("F4").Value = tar_rowcnt + src_rowcnt
    End With
    
    Application.ScreenUpdating = False
    'data transfer
    'range 1 (A:F)
    ws_srcdata.Range("A2:F" & src_lrow).Copy
    ws_tardata.Range("G" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 2 (G)
    ws_srcdata.Range("G2:G" & src_lrow).Copy
    ws_tardata.Range("N" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 3 (H:I)
    ws_srcdata.Range("H2:I" & src_lrow).Copy
    ws_tardata.Range("P" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 4 (J:O)
    ws_srcdata.Range("J2:O" & src_lrow).Copy
    ws_tardata.Range("S" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 5 (P:U)
    ws_srcdata.Range("P2:U" & src_lrow).Copy
    ws_tardata.Range("AA" & tar_dest).PasteSpecial Paste:=xlPasteValues
    'range 6 (W:AD)
    ws_srcdata.Range("W2:AD" & src_lrow).Copy
    ws_tardata.Range("AG" & tar_dest).PasteSpecial Paste:=xlPasteValues
    
    'save target
    'wb_main.Save
    
    'close source (without saving)
    Application.DisplayAlerts = False
    wb_srcbook.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

The date in cell B4 is incrementing as expected, but the other fields (B2, E4, F4) are not updating.