VBA code works when called directly, but not from another routhine

[davidepstein22]

Hello,

Routine 1 updates the sales information correctly.

Routine 2 updates the the cell's color based on the sales value when I run the code directly using a button on the sheet (not parameters or variables are passed to the code).

However, when I call routine 2 from routine 1 (after the sales values are updated), none of the cells color is updated (no errors are presented). However, when I call routine 2 directly, the code works as expected.

Below are routines 1 and 2 (again, no errors are observed). Please let me know if you see an error or have any recommendations.

Thank you,
Dave

ROUTINE 1
Sub UpdateSalesSheet()

'This routine copies products from the Products sheet to the Sales sheet and then read the new month's sales files and enters the Unit Sold for each model #.

Application.ScreenUpdating = False
Dim salesmonthenddate As String
Dim cel, rng As Range
Dim found, result, x, productforecast, productforecasthigh, productforecastlow As Integer
Dim tblSalesUnitsSoldcolumn, tblSalesLastRow, qty, mm, yyyy As Integer
Dim fso As Object
Dim filedate As Date
Dim UnitsSold() As Variant

ReplaceUnitSoldFormulas

'confirm sales files are in the Sales folder. if not, cancel the update.
Set fso = CreateObject("Scripting.FileSystemObject")

spath = Range("PQ_Path_to_Sales_by_Customers").Text & "*.xlsx"
spath1 = Range("PQ_Path_to_Sales_by_Customers").Text

Filename = Dir(spath)
filedate = Format(FileDateTime(Left(spath, Len(spath) - 6) & Filename), "mm/dd/yyyy")
Do While Filename <> ""
filecount = filecount + 1
Filename = Dir()
If Filename <> "" Then
If filedate <> Format(FileDateTime(Left(spath, Len(spath) - 6) & Filename), "mm/dd/yyyy") Then
showwarning = True
End If
End If
Loop

If showwarning = True Then
result = MsgBox("There are files with different date stamps, which may indicate you are attempting to process an old file. Please confirm you copied all of the current sales to the prescribed folder and then restart this process. You can override this warning by clicking 'Yes'. If you are unsure click 'No' and confirm you have the correct files in the Sales folder.", vbYesNo)
If result = 7 Then
End 'cancel execution
End If
End If

If filecount < 2 Then
MsgBox "No sales files were found in the " & spath & " folder. Please copy the sales files to the prescribed folder and then restart this process."
Exit Sub
End If

salesmonthenddate = InputBox("Enter the Sales Month End Date (mm/dd/yyyy):")

'confirm/convert to month end date
dateentered = IsDate(salesmonthenddate)
If dateentered = True Then
mm = Month(salesmonthenddate)
yyyy = Year(salesmonthenddate)
salesmonthenddate = Application.WorksheetFunction.EoMonth(salesmonthenddate, 0)
salesmonthenddate = Format(salesmonthenddate, "m/d/yyyy")
ActiveWorkbook.Worksheets("Missing Sales").Range("l2").Value = salesmonthenddate

'confirm Sales were not already entered for the month entered
Sheets("Sales").Select
ActiveSheet.ListObjects("Sales").ListColumns("Month End Date").DataBodyRange.Select

On Error Resume Next
found = Cells.Find(What:=salesmonthenddate, After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If found = True Then
MsgBox "One or more rows were found with sales for month ending: " & salesmonthenddate & " The process will not allow duplicates to be created."
Sheets("Sales").Select
Range("A1").Select
Exit Sub
End If
On Error GoTo 0

'get last row of Sales Table before new month's data is copied to it
tblSalesLastRow = ActiveSheet.ListObjects("Sales").DataBodyRange.Rows.Count + 1
tblSalesUnitsSoldcolumn = 6

'Clear Last_Months_Sales table
Range("Table_Last_Months_Sales").Clear

'Refresh data from Power Queries
ActiveWorkbook.RefreshAll

'Refresh Last Month Sales table using Power Query
'ActiveWorkbook.Worksheets("Last Months Sales").ListObjects("Table_Last_Months_Sales").QueryTable.Refresh BackgroundQuery:=False
'ThisWorkbook.Worksheets("Sales by Customers").ListObjects("Table_Sales_by_Customers").QueryTable.Refresh BackgroundQuery:=False
DoEvents

'Copy the Products to the Sales sheet if date > 0 and date is not blank
Sheets("Products").Select

'Write new records
Range("A2").Select
Do While ActiveCell.Text <> ""
'read row
productname = ActiveCell.Text
desc = ActiveCell.Offset(0, 1)
modelnum = ActiveCell.Offset(0, 2)
clr = ActiveCell.Offset(0, 3)
dd = ActiveCell.Offset(0, 5)

If dd <> "" And dd > 0 Then 'write row on Sales sheet
Sheets("Sales").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = productname
ActiveCell.Offset(0, 1) = desc
ActiveCell.Offset(0, 2) = modelnum
ActiveCell.Offset(0, 3) = clr
ActiveCell.Offset(0, 4) = salesmonthenddate
ActiveCell.Offset(0, 5).Formula = "=SUMIF('Last Months Sales'!$H$2:$H$200, [@[Model '#]] ,'Last Months Sales'!$I$2:$I$200)"
End If

Sheets("Products").Select
ActiveCell.Offset(1, 0).Select

Loop

'Sort sales table so the current month is first (sort newest to oldest on Month End date and then Product alphabetically)
ActiveWorkbook.Worksheets("Sales").ListObjects("Sales").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sales").ListObjects("Sales").Sort.SortFields.Add2 _
Key:=Range("Sales[Month End Date]"), SortOn:=xlSortOnValues, Order:= _
xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sales").ListObjects("Sales").Sort.SortFields.Add2 _
Key:=Range("Sales[Product]"), SortOn:=xlSortOnValues, Order:=xlAscending _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sales").ListObjects("Sales").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'create sales folder and move processed files into folder
If ComputerRunningCode = "Ken" Then
On Error Resume Next
MkDir "C:\Users\Ken\Documents\RBO LLC\Shipping\RBO Shipment Report\Backup\" & "Sales " & yyyy & "-" & Format(mm, "00")
On Error GoTo 0
fso.copyfile spath1 & "*.*", "C:\Users\Ken\Documents\RBO LLC\Shipping\RBO Shipment Report\Backup\Sales " & yyyy & "-" & Format(mm, "00")
ElseIf ComputerRunningCode = "Dave" Then
On Error Resume Next
MkDir "C:\Users\david\OneDrive\Documents\Dave\Computer Catering\Waldman\Backup\" & "Sales " & yyyy & "-" & Format(mm, "00")
On Error GoTo 0
fso.copyfile spath1 & "*.*", "C:\Users\david\OneDrive\Documents\Dave\Computer Catering\Waldman\Backup\Sales " & yyyy & "-" & Format(mm, "00")
End If

Set fso = Nothing

Else
MsgBox "You did not enter a valid date. Please try again."

End If

UpdateSalesSheetCellColors

Application.ScreenUpdating = True

End Sub


ROUTINE 2


Sub UpdateSalesSheetCellColors()

Application.ScreenUpdating = False

'update Report sheet cell colors
Worksheets("Reports").Select
ProductYear = Range("ProductYear").Text
Range("ProductYearFirstProduct").Select
Do While ActiveCell.Text <> ""
productname = ActiveCell.Text
For months = 1 To 12
Worksheets("Forecast").Select
'get forecast value for the product/month
productforecast = WorksheetFunction.Index(Worksheets("Forecast").Range(Cells(2, months + 2), Cells(500, months + 2)), WorksheetFunction.Match(productname & ProductYear, Worksheets("Forecast").Range("P2:P500"), 0))
productforecastlow = (1 - Worksheets("Control").Range("G2")) * productforecast
productforecasthigh = (1 + Worksheets("Control").Range("G2")) * productforecast


'=XLOOKUP(H5,months,XLOOKUP(H4,names,data)) 'this is a test line of code to increase the execution speed.

Worksheets("Reports").Select
'find product name row
Range("ProductYearFirstProduct").Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Find(What:=productname, After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
, MatchCase:=False, SearchFormat:=False).Activate

found = ActiveCell.Row

'select the cell
ActiveSheet.Cells(found, months + 1).Select
salescount = ActiveCell.Value

'apply cell background - green, red or no fill
If ((salescount > 0) And (salescount >= productforecasthigh)) Then
'ActiveCell.Interior.Color = RGB(0, 255, 0)
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ElseIf ((salescount > 0) And (salescount <= productforecastlow)) Then
'ActiveCell.Interior.Color = RGB(255, 0, 0)
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else 'no background color
'ActiveCell.Interior.Color = RGB(255, 255, 255)
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If

Next months
Worksheets("Reports").Select
ActiveCell.Offset(1, 0).Select
Cells(ActiveCell.Row, 1).Select

Loop

my_cell = Range("ProductYear").Address
cell_row = Range(my_cell).Row
cell_col = Range(my_cell).Column

'moves to the top left corner
ActiveWindow.SmallScroll ToRight:=-9999
ActiveWindow.SmallScroll Up:=-99999

'moves to your active cell
ActiveWindow.ScrollRow = cell_row
ActiveWindow.ScrollColumn = cell_col

'selects your cell
Range(my_cell).Select
DoEvents

MsgBox "The cell colors were updated."

Application.ScreenUpdating = True

End Sub

 

[JonRowland]

A quick glance suggests that the values are not updated before calling Routine 2. This will affect the colour. Try moving Application.ScreenUpdating = True above UpdateSalesSheetCellColors. This will update the values so the colouring should work.

 

[Skyybot]

Also, you say no Errors occur, but you have On Error statements in your code. If you comment out the On Error statements, you may be able to find out where the problem is.

 

[davidepstein22]

A quick glance suggests that the values are not updated before calling Routine 2. This will affect the colour. Try moving Application.ScreenUpdating = True above UpdateSalesSheetCellColors. This will update the values so the colouring should work.

Thank you for your suggestion. I tried it and even added a "doevents" statement after I set the Application.ScreenUpdating = True, but it still did not work.

 

[davidepstein22]

Also, you say no Errors occur, but you have On Error statements in your code. If you comment out the On Error statements, you may be able to find out where the problem is.

Fair statement, but those "on error" statements trap specific, which are legitimate. Clearly, I could add code and remove the on error resume next statements, but this is not the cause of my issue. Please note that immediately after the on error statement I have "on error goto 0", which will allow errors to be reported.

Please note, routine 2 runs correctly when run directly from a button on the sheet, but not when called from routine 1 (and no variable are passed to routine 2 from routine 1).

Any other thoughts?

Thank you,
Dave

 

[davidepstein22]

Hi again,

I am just trying to get closure to a nagging issue. For simplicity, procedure 1 updates my sales and procedure 2 applies colors to the sales for each product (red, green or no fill). Both routines work correctly when run individually and in the debug mode. However, when procedure 1 call procedure 2 I determined that the new sales data is not visible on the "Reports" sheet. Hence, when the color-cell logic code is executed no colors are applied.

I tried removing the screen updating = false and even doing an application.calcluate, doevents and screen updating = true before the color cell logic is executed, but it simply does not work. Does anyone have an idea why the formulas that read the sales dates are not populating the cells on the Reports sheet.

I removed all of the error handling.


Thanks,
Dave

 

[Skyybot]

@davidepstein22 , Have you tried Application.Volitile at the beginning of both Sub's?

 

[davidepstein22]

I received an error because my procedure is a Sub, not a Function. Any other suggestions?

Thank you,
Dave