Subroutine Processing Visuals

[steveh8204]

I've just finished creating my VBA spreadsheet and while it's very useful and 'a bit of a beast' it's not so impressive to look at while running. I played around with turning screenupdating on and off and either way doesn't make much difference so was just wondering if anyone had any tips on making it look better?

I'm running windows 10 and even though it appears to hang (the status bar says Not Responding for a few seconds) it does run but the screen is mainly white and with the aforementioned unresponsive message to the casual observer it looks sloppy. It runs for about 8-10 secs in total.

I did read a thread about a progress bar but the example didn't work as my sub routine is to run several sub routines so I wasn't able to base it on just on one calculation.

Any tips to 'clean it up' would be appreciated as it's the finishing touchs to a very long and painstaking project.

 

[Puertorekinsam]

You can use the status display in the bottom right of the report:


Declare a public variable

Public oldStatusBar

Then in the first subroutine start with this:

oldStatusBar = Application.DisplayStatusBar 
Application.DisplayStatusBar = True
Application.StatusBar = "Step 1: Starting Program"

and before the end sub put this

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

then at the start of each sub routine, use something like this

Application.StatusBar = "Step X of Y: Starting Sub Routine ABC. "

 

[steveh8204]

Hi sorry would have replied earlier but I can only modify the spreadsheet in work as its connected to network files.

Had a go first thing and it's a very easy tip to follow, slipped in the code no problem thanks.

Works a treat to, except, I can see the text but only slightly because as soon as I run the macro the screen pretty much goes white except the bottom bar which turns darkish green (the Office Excel 2016 green) and the text is a dark colour which barely sticks out on this bar. Gutted.

I thought it was too easy. Screenupdating doesn't make much different if on or off.

Thanks anyway though, a great little snippet of code to know.

 

[Norie]

What exactly are you seeing as the code runs?

 

[steveh8204]

All the ribbon disappears, and all the spreadsheet and its basically all white except the bottom bar. Excel hangs for a couple of seconds in the middle of the routine and then it all pops up with my custom 'all done' dialog box.

The routine is called from a Userform in the 'Work book open' sub in the 'thisworkbook' code window. The user form appears on startup but calls a sub which runs about four subs in order.

 

[Norie]

What is the code doing?

Does it involve a lot of calculation?

 

[steveh8204]

Yes, it is comparing the data on two sheets (approx 170 rows on each) converting half the amounts on one for specific cells (via vlookups) comparing the amounts on each and highlighting differences (if any). Also counting the rows on each, using Countif to find and identify unique entries.

It does do some work.

 

[Norie]

Can you post a sample of the code?

 

[steveh8204]

The following is all the code I have in the 'ThisWorkbook > Workbook' Code Window:

Private Sub Workbook_Open()

Application.ScreenUpdating = False
' check if a report wants to be run
    Message = "Do you want to run a Stock Status Report?"
    answer = MsgBox(Message, vbYesNo, "Vigo Stock Checker")
    If answer = vbNo Then End
    If answer = vbYes Then
        End If

oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Importing SAP Stock figures"

' print timestamp of time file is initially run
Dim timestamp As String, info As String
    timestamp = ("Check initiated at ")
    a = Worksheets(1).Range("C1").Value
        If a > 0 Then End
    info = timestamp & Now
    Range("C1").Value = info
    Worksheets("VigoStock").Activate
    Range("A1").Value = info

' import SAP stock figures
    Worksheets("SAP").Activate
    Dim wb As Workbook
    Dim myfilename As String
    myfilename = "P:\PFMSHARE\LOGISTICS\STOCK CHECK DOCUMENTS & BBE CHECKER\Macs Auto Stock Checker\Macs All.MHTML"
    Set wb = Workbooks.Open(myfilename)
    a = Range("A2:d200").Copy
    Workbooks("Macs Auto Stock Check.xlsm").Activate
    Paste = a
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3").Select
Sheets(2).Activate

Application.StatusBar = "Importing Vigo Stock figures"

' import Vigo figures
myfilename = "P:\PFMSHARE\LOGISTICS\STOCK CHECK DOCUMENTS & BBE CHECKER\Macs Auto Stock Checker\MacsVigoExport.xlsm"
Set wb = Workbooks.Open(myfilename)
b = Range("A1:G200").Copy
Workbooks("Macs Auto Stock Check.xlsm").Activate
Sheets("VigoStock").Activate
Paste = b
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3").Select
Application.DisplayAlerts = False

Application.StatusBar = "Closing External Links"

' close additional workbooks
Workbooks("MacsVigoExport.xlsm").Close
Workbooks("Macs All.MHTML").Close

Call runall

Application.ScreenUpdating = True

End Sub

and the following is all the code for my main macros in the Module code Window:

Option Explicit
Dim r As Integer, i As Integer
Dim convertedqty As Double, kiloconvert As Double, lookup2 As Double, sapstock As Double, v As String, rcount As Integer
Public vcount As Integer
Public oldStatusBar
Dim tcount As Integer, l As Integer, a As Variant
Sub checkinfo()

Dim lookup1 As Long, Rtrue As Long, Ptrue As Long, r As Integer
' counts how many rows exist (- headings)
r = Cells(Rows.Count, 1).End(xlUp).Row - 2
For i = 3 To r + 2
' these variables check for whether material is a raw (there is a corresponding "pack size" or a packaging item (anything else)
Rtrue = 0
Ptrue = 0
' determine the cell to get lookup value from
v = Cells(i, 3).Value
On Error Resume Next
' any value picked up from the following vlookup is a Raw Material
Rtrue = Application.WorksheetFunction.VLookup(v, Sheets("PackSize").Range("packsizes"), 2, False)
Err.Clear
Select Case Rtrue
        Case Is > 0 ' if this is true the material is a Raw and diverts to sub to convert quantities
            
convertquantities ' run the sub to convert quantities
    Case Else
' this code will show a value if the material is a packaging line
Ptrue = Application.WorksheetFunction.VLookup(v, Sheets("VigoStock").Range("AllVigoStock"), 7, False)
sapstock = Cells(i, 4)
lookup1 = 0 ' make sure variable is reset from previous loops
lookup1 = Application.VLookup(v, Range("AllVigoStock"), 7, False)
If lookup1 = sapstock Then
    Cells(i, 5).Value = "Quantity Is Correct"
    Cells(i, 6).Value = "" ' used to blank cells if re-running check
    Cells(i, 7).Value = ""
   Else
 
Cells(i, 5).Value = "Incorrect Quantity"
Cells(i, 6).Value = lookup1 - sapstock
Err.Clear
End If
End Select
Next i
End Sub
Sub convertquantities()
' all codes are "looked up" on SAP sheet and compared to:
On Error Resume Next
lookup2 = 0 ' make sure variable is reset from previous loops
' lookup = quantity on Vigo of given product
lookup2 = Application.VLookup(v, Range("AllVigoStock"), 7, False)
' kiloconvert = packsize of given product
kiloconvert = Application.VLookup(v, Range("packsizes"), 2, False)
convertedqty = lookup2 * kiloconvert
sapstock = Cells(i, 4)
If convertedqty = sapstock Then
Cells(i, 5).Value = "Quantity Is Correct"
Cells(i, 6).Value = ""
Cells(i, 7).Value = ""
Else
Cells(i, 5).Value = "Incorrect Quantity"
Cells(i, 6).Value = convertedqty - sapstock
End If
End Sub
Sub runall()
' run to check the row count and SAP quantity check at the same time
Dim q As Integer, msg As String, config As String, ans As Variant
' Application.ScreenUpdating = False
q = 1
Application.StatusBar = "Reconciling SAP Stock"
Sheets("SAP").Activate
    checkinfo
Application.StatusBar = "Checking Vigo and SAP Row Counts"
Sheets("VigoStock").Activate
    dorowsmatch
    
Application.StatusBar = "Highlighting Vigo Stock Gains"
    
    highlightvigo
Application.StatusBar = "Highlighting SAP Losses"
Sheets("SAP").Activate
    vigozero
    
Sheets("VigoStock").Activate
q = 0
msg = "SAP Raws and Packaging status checked"
msg = msg & vbNewLine & vbNewLine
msg = msg & "Variance on Vigo is " & tcount
msg = msg & vbNewLine
msg = msg & "(Highlighted if positive)"
config = vbOKOnly + vbInformation
ans = MsgBox(msg, config, "Check Complete")
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
' Application.ScreenUpdating = True
End Sub
Sub dorowsmatch()
Dim pcount As Integer
' count the rows in each column to confirm they match on first sheet (Vigo Raws)
' Application.ScreenUpdating = False
Sheets("VigoStock").Activate
    vcount = Cells(Rows.Count, 1).End(xlUp).Row - 2 ' Vigo row count
Sheets("SAP").Activate
    rcount = Cells(Rows.Count, 1).End(xlUp).Row - 2 ' SAP count
Sheets("VigoStock").Activate
    Range("i2") = vcount ' Vigo total
    Range("j2") = rcount ' SAP Total
    tcount = vcount - (rcount + pcount) ' Variance
    Range("k2") = tcount '
    
' Application.ScreenUpdating = True
End Sub
Sub ClearContents()
'
' Clear Cells Macro
'
Application.ScreenUpdating = False
    Range("a3:g300").ClearContents
    Range("linestatus").ClearContents
    
Application.ScreenUpdating = True
      
End Sub
Sub highlightvigo()
For i = 3 To vcount + 2
a = 0
a = Application.WorksheetFunction.CountIf(Range("SAP!C:C"), Cells(i, 1))
For l = 1 To 7
If a = 0 Then Cells(i, l).Select
    With Selection.Font
        .Bold = True
        .Color = -11489280
        .TintAndShade = 0
    End With
    Next l
Next i
Range("a3").Select
    Selection.Font.Bold = False
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
End Sub
Sub vigozero()
Dim z As Variant, y As Variant, f As Double, h As Double
For f = 3 To rcount
z = Cells(f, 4).Value
y = Cells(f, 6).Value
For h = 1 To 4
If z + y = 0 Then Cells(f, h).Select
    With Selection.Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
    End With
    Next h
    Next f
End Sub

 

[Norie]

There's quite a bit of unneeded activating/selecting in that code which could explain, in part at least, your problem.

I would post alternative code but I'm having trouble understanding some of it.

For example, what's happening here?

  a = Range("A2:d200").Copy
    Workbooks("Macs Auto Stock Check.xlsm").Activate
    Paste = a
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3").Select

I'm assuming you are copying A2:D200 from a worksheet in the workbook you've opened to another worksheet in another workbook but I've never seen code like this for doing that, I can't actually get the code to compile.


PS Here's some alternative code for some parts of the second section of code.

Sub runall()
' run to check the row count and SAP quantity check at the same time
Dim q As Integer, msg As String, config As String, ans As Variant
' Application.ScreenUpdating = False

    q = 1
    Application.StatusBar = "Reconciling SAP Stock"
    
    Sheets("SAP").Activate
    checkinfo
    
    Application.StatusBar = "Checking Vigo and SAP Row Counts"
    
    dorowsmatch
        
    Application.StatusBar = "Highlighting Vigo Stock Gains"
    highlightvigo
    
    Application.StatusBar = "Highlighting SAP Losses"
    
    vigozero
        
    Sheets("VigoStock").Activate
    q = 0
    msg = "SAP Raws and Packaging status checked"
    msg = msg & vbNewLine & vbNewLine
    msg = msg & "Variance on Vigo is " & tcount
    msg = msg & vbNewLine
    msg = msg & "(Highlighted if positive)"
    config = vbOKOnly + vbInformation
    ans = MsgBox(msg, config, "Check Complete")
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
    ' Application.ScreenUpdating = True
    
End Sub

Sub dorowsmatch()
Dim pcount As Long

    vcount = Sheets("VigoStock").Cells(Rows.Count, 1).End(xlUp).Row - 2 ' Vigo row count
    rcount = Sheets("SAP").Cells(Rows.Count, 1).End(xlUp).Row - 2 ' SAP count

    With Sheets("VigoStock")
        .Range("i2") = vcount ' Vigo total
        .Range("j2") = rcount ' SAP Total
        tcount = vcount - (rcount + pcount) ' Variance
        .Range("k2") = tcount '
    End With

End Sub

Sub highlightvigo()

    For i = 3 To vcount + 2
        a = 0
        With Sheets("VigoStock")
            a = Application.WorksheetFunction.CountIf(Range("SAP!C:C"), .Cells(i, 1))
        
            If a = 0 Then
                With .Cells(i, l).Resize(, 7).Font
                    .Bold = True
                    .Color = -11489280
                    .TintAndShade = 0
                End With
            End If
        End With
        
    Next i

    With Sheets("VigoStock").Range("a3").Font
        .Bold = False
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
        
End Sub

Sub vigozero()
Dim z As Variant, y As Variant, f As Double, h As Double

    With Sheets("SAP")
        For f = 3 To rcount
            z = .Cells(f, 4).Value
            y = .Cells(f, 6).Value
            For h = 1 To 4
            If z + y = 0 Then
                With .Cells(f, 1).Resize(, 4).Font
                    .Bold = True
                    .Color = -16776961
                    .TintAndShade = 0
                End With
            End If
        Next f
    End With
    
End Sub