Worksheet Display Not Updating Through Loop Process

Ark68

Well-known Member
Consider this code below:

Rich (BB code):
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.

<b></b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5 " /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5 ;text-align: center;color: #161120"><th></th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;">148</td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;">149</td><td style="text-align: right;border-left: 1px solid black;;"></td><td style="text-align: center;border-bottom: 1px solid black;background-color: #C5D9F1;;">RECORDS</td><td style="text-align: center;border-bottom: 1px solid black;background-color: #C5D9F1;;"></td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="font-weight: bold;text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #16365C;background-color: #C5D9F1;;">DATE</td><td style="font-weight: bold;text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #16365C;background-color: #C5D9F1;;"></td><td style="text-align: right;border-right: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;background-color: #C5D9F1;;">Date</td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;background-color: #C5D9F1;;">Cuml.</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: center;border-top: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;">20-Oct-19</td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;;"></td><td style="text-align: right;border-right: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;">2</td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;">5024</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="font-weight: bold;text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #16365C;background-color: #C5D9F1;;">Missing Dates</td><td style="font-weight: bold;text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #16365C;background-color: #C5D9F1;;"></td><td style="text-align: right;border-left: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;;"></td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: center;border-top: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;">11-Oct-19</td><td style="text-align: center;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;;"></td><td style="text-align: right;border-left: 1px solid black;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: center;border-top: 1px solid black;;">14-Oct-19</td><td style="text-align: center;border-top: 1px solid black;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5 ;color: #161120">FRONT</p><br /><br />

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.

Rich (BB 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") = 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

MrExcel MVP, Moderator
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

Well-known Member
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

Well-known Member
Ahhh ... ok. That would do it ... thank you both!

I changed my code ...

Rich (BB 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.
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Macro to copy values across rows and transposing them and add the user id
    [FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Hi,[/COLOR][/SIZE][/FONT] [FONT=Times New...
Top