UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Compare Two Tables For Differences And Highlight With Interior Colors On Export To Excel, Access 2010    
 
   
roberjh
post Jan 16 2017, 03:21 PM
Post#1



Posts: 3
Joined: 14-January 17



Hello everyone.

I have written a code that will export a table to excel with specific formatting. The idea behind the code is to take a manual copy and paste into 16 documents process and automate using Access. There are two pieces I am missing.


1. Color a row gray based on a specific column condition
The code below only colors the cell
.Range("B7:B" & i).FormatConditions.Add(xlCellValue, xlEqual, "=""X""")
.Interior.Color = RGB(196, 189, 151)
2. I need to find a way to track changes between two tables and highlight the changes a specific color in the export to excel.
I have no clue where to begin this tracking.
My first thought was to take the first code below (which is the code used to update the master table) and add a code to allows users to save the table with a different name. Within that code or the second code below somehow add a code that would compare the two tables (the master and the newly created) for differences then catalog the cell and date. Then with the export of the newly created table to Excel, highlight the cells that were different from the master. But I have no clue where to begin.

Please let me know what you all think is the best approach. I am a novince and would greatly appreciate the help on the code.


Code 1:
Function DistCom()
On Error GoTo SubError
Dim cnn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim Inserts As Long
Dim WhseUpdate As Long
Dim DateUpdate As Long
Dim SQL As String
Dim fDialog As Office.FileDialog
Dim varFile As Variant

'Indicate to user we are doing something
DoCmd.Hourglass True
txtResults = ""
DoEvents


' Set up the File Dialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog
.Title = "Choose the spreadsheet you would like to import"
.AllowMultiSelect = False
.ButtonName = "Confirm"
.InitialFileName = "C:\Users\E54012\Desktop\RTM Doc Link\Attempt 3\" 'Folder picker needs trailing slash JD

.Filters.Clear
.Filters.Add "Excel files", "*.xls*"


If .Show = True Then
If .SelectedItems.Count = 0 Then
'User clicked open but didn't select a file
GoTo SubExit
End If

'An option for MultiSelect = False
varFile = .SelectedItems(1)


'Open connection to our spreadsheet
Set cnn = New ADODB.Connection
With cnn


.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & varFile & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"

.Open
End With

Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
Set rs = New ADODB.Recordset

' Query the workheet
SQL = "SELECT DistributorDCACN, FirstOrderDate, DistributorOwnership, DistributorDCWarehouseNum, Action FROM [ECommLink$] "

cmd.CommandText = SQL
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockReadOnly
rs.Open cmd

'Update the database
Do Until rs.EOF
If IsNull(rs!DistributorDCACN) Or rs!DistributorDCACN = "" Then

GoTo GetNext
End If

Select Case Nz(rs!Action, "")
Case "New"
SQL = "INSERT INTO tblRDDL "
SQL = SQL & "(DistributorDCACN, FirstOrderDate, DistributorOwnership, DistributorDCWarehouseNum) "
SQL = SQL & "VALUES "
SQL = SQL & "('" & rs!DistributorDCACN & "', '" & Nz(rs!FirstOrderDate, "") & "', '" & Nz(rs!DistributorOwnership, 0) & "', '" & Nz(rs!DistributorDCWarehouseNum, 0) & "')"
CurrentDb.Execute SQL, dbFailOnError
Inserts = Inserts + 1

Case "WhseUpdate"
SQL = "UPDATE tblRDDL "
SQL = SQL & "SET DistributorDCWarehouseNum = '" & Nz(rs!DistributorDCWarehouseNum, 0) & "' "
SQL = SQL & "WHERE DistributorDCACN = '" & rs!DistributorDCACN & "' "
CurrentDb.Execute SQL, dbFailOnError
WhseUpdate = WhseUpdate + 1

Case "DateUpdate"
SQL = "UPDATE tblRDDL "
SQL = SQL & "SET FirstOrderDate = '" & Nz(rs!FirstOrderDate, "") & "' "
SQL = SQL & "WHERE DistributorDCACN = '" & rs!DistributorDCACN & "' "
CurrentDb.Execute SQL, dbFailOnError
DateUpdate = DateUpdate + 1

Case Else


End Select

GetNext:
rs.MoveNext
Loop

txtResults = "ARTM - E-Commerce Implementations Update complete." & vbCrLf & vbCrLf & "ARTM - E-Commerce Implementations: " & Inserts & vbCrLf & _
"First Order Date Updates: " & DateUpdate & _
vbCrLf & "Warehouse Code Updates: " & WhseUpdate

Else
'Show if Canceled is selected in a message box
varFile = "No File Selected to Import."
MsgBox varFile

End If

End With

SubExit:
On Error Resume Next
DoCmd.Hourglass False
If Not cmd Is Nothing Then
Set cmd = Nothing
End If
If Not cnn Is Nothing Then
cnn.Close
Set cnn = Nothing
End If
Set rs = Nothing
Set fDialog = Nothing

Exit Function

SubError:
MsgBox "Error Number: " & Err.Number & " = " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
End Function


Code 2:

Function exportRDDL()

On Error GoTo SubError

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer

'Show user work is being performed
DoCmd.Hourglass (True)

'*********************************************
' RETRIEVE DATA
'*********************************************
'SQL statement to retrieve data from database
SQL = "SELECT FirstOrderDate, PreviousSupplyingBottlerFirstOrderDate, DeactivatedDCCannotorderwithoutbeingreactivated, DivestitureImplementationorSupplyingBottlertransferagreementimpl, FirstDeliveryDateCurrentSupplyingBottler, FirstDeliveryDatePreviousSupplyingBottler, DistributorDCSignedContract, ARTMBroadlinerContractsSigned, LARTM, LARTMContractTier, NARTM, B2B, ECOM, Mcs, DD, Bids, AssignedARTMNationalRetailers, DNSE, NotesAboutDistributorDC, DistributorOwnership, DistributorDC, DistributorDCShipToAddress, DistributorDCCity, DistributorDCState, DistributorDCZipCode, CurrentDistributorDCDeliveryOutletNum, PreviousDistributorDCDeliveryOutletNum, DistributorDCACN, DistributorDCWarehouseNum, WarehouseNumlength, EDIRCIandEDIProfileforCONA, OrderEDISetId, InvoiceEDISetID, CBSAccountNumber, OrderMethodusedbydistributorDCtoCBSManualorEDI850, PreviousSupplyingBottler, PPLLocalRegion, CurrentBottlerdeliveringtodistributorDC, IndirectSalesLocation, DeliveryLocation " & _
"FROM tblRDDL " & _
"ORDER BY FirstOrderDate "

'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

'If no data, don't bother opening Excel, just quit
If rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If

'*********************************************
' BUILD SPREADSHEET
'*********************************************
'Create an instance of Excel and start building a spreadsheet

'Early Binding
Set xlApp = Excel.Application

xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

With xlSheet
.Name = "RDDL"
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 9
ActiveWindow.DisplayGridlines = False


'Set column widths
.Columns.AutoFit = True
' .Columns("A").ColumnWidth = 17
' .Columns("B").ColumnWidth = 17
' .Columns("C").ColumnWidth = 10
' .Columns("D").ColumnWidth = 10
' .Columns("E").ColumnWidth = 25
' .Columns("F").ColumnWidth = 25

'Format columns
' .Columns("A").NumberFormat = "@"
' .Columns("C").NumberFormat = "$#,##0.00;-$#,##0.00"
' .Columns("D").NumberFormat = "$#,##0.00;-$#,##0.00"
' .Columns("F").NumberFormat = "#,##0.0#%;-#,##0.0#%"

'build report heading
.Range("G4", "H4").Merge
.Range("G5", "H5").Merge
.Range("I4", "IH4").Merge
.Range("I5", "I5").Merge
'.Range("A1").HorizontalAlignment = xlCenter
'.Range("A2").HorizontalAlignment = xlCenter
.Range("A1").Cells.Font.Bold = True
.Range("A4").Cells.Font.Bold = True
.Range("A5").Cells.Font.Bold = True
.Range("B5").Cells.Font.Bold = True
.Range("A1").Cells.Font.Italic = True
'.Range("A1").Cells.Font.Name = "Cambria"
.Range("A1").Cells.Font.Size = 12
.Range("A2").Cells.Font.Size = 11
.Range("A3").Cells.Font.Size = 11
.Range("A4").Cells.Font.Size = 11
.Range("A5").Cells.Font.Size = 11

.Range("A1").Value = "Retailer Distributor DC Linkage (RDDL)"
.Range("A2").Value = "ARTM Distributor DC Implementations Tracking Tool sorted by Implementation ""Go Live"" date"
.Range("A3").Value = "List of National Retailers and Implementations put on Hold can be found on the Weekly ARTM CBS Summary"
.Range("A4").Value = "This document is confidential"
.Range("A5").Value = ["Updated" Date]
'.Range("B5").Value = Date
.Range("G1").Value = "Font:Arial 9"
.Range("G4").Value = "Changes last week: "
.Range("G5").Value = "Changes this week: "
.Range("I4").Formula = Date - Weekday(Date, 2) - 6 & "-" & Date - Weekday(Date, 2) - 2
.Range("I5").Formula = Date - Weekday(Date, 2) + 1 & "-" & Date - Weekday(Date, 2) + 5

'build column headings
.Range("A").Value = "First Order Date (Current/Active Supplying Bottler) RTM Implementations Go Live Date - First Week Distributor DC can send orders to CBS"
.Range("B").Value = "Previous/Old Supplying Bottler First Order Date"
.Range("C").Value = "Deactivated DC - Cannot order without being reactivated"
.Range("D").Value = "Divestiture Implementation or Supplying Bottler transfer agreement implementation"
.Range("E").Value = "First Delivery Date (Current/Active Supplying Bottler) Based on first bottler delivery invoices submitted to CIS"
.Range("F").Value = "First Delivery Date (Previous/Old Supplying Bottler) Based on first bottler delivery invoices submitted to CIS"
.Range("G").Value = "Distributor DC Signed Contract"
.Range("H").Value = "ARTM Broadliner - Local & Natl (both) Contracts Signed"
.Range("I").Value = "LARTM"
.Range("J").Value = "LARTM Contract Tier"
.Range("K").Value = "NARTM"
.Range("L").Value = "B2B"
.Range("M").Value = "E-COM"
.Range("N").Value = "Mcs"
.Range("O").Value = "DD"
.Range("P").Value = "Bids(prisons, airports, schools)"
.Range("Q").Value = "Assigned ARTM National Retailer(s) implemented and authorized to be delivered to by this distributor DC"
.Range("R").Value = "DNSE Distribution National Sales Executive or NAE (National Sale Executive)"
.Range("S").Value = "Notes about Distributor DC"
.Range("T").Value = "Distributor Ownership"
.Range("U").Value = "Distributor DC"
.Range("V").Value = "Distributor DC Ship To Address"
.Range("W").Value = "Distributor DC City"
.Range("X").Value = "Distributor DC State"
.Range("Y").Value = "Distributor DC Zip Code"
.Range("Z").Value = "Current/Active or New SOF Bottler Num - Distributor DC delivery outlet Num A.K.A.: Type 5 outlet, CRD outlet, External Sales outlet Num 's"
.Range("AA").Value = "Previous/Old - Distributor DC delivery outlet Num A.K.A.: Type 5 outlet, CRD outlet, External Sales outlet"
.Range("AB").Value = "Distributor DC ACN Num"
.Range("AC").Value = "Distributor DC Warehouse Num Should be in the Store Num field for Master Data"
.Range("AD").Value = "Warehouse Num (Store Num) length"
.Range("AE").Value = "EDIRCI and EDI Profile for CONA"
.Range("AF").Value = "Order EDISetId"
.Range("AG").Value = "Invoice EDI SetID"
.Range("AH").Value = "CBS Account Number"
.Range("AI").Value = "Order Method used by distributor DC to CBS: Manual or EDI 850"
.Range("AJ").Value = "Previous/Old Supplying Bottler"
.Range("AK").Value = "Local (LARTM) Contract Signed: Price Region"
.Range("AL").Value = "Current Bottler delivering to distributor DC A.K.A.: Delivering Bottler, Supplying Bottler, Producing Bottler, Territory Bottler"
.Range("AM").Value = "Indirect Sales Location Sales Center where product will be pulled from"
.Range("AN").Value = "Delivery Location Sales Center that will make delivery to distributor DC"


'Format Column Headings
.Range("A6:AN6").HorizontalAlignment = xlCenter
.Range("A6:AN6").Cells.Font.Bold = True
.Range("C6").Interior.Color = RGB(221, 217, 196)
.Range("A6:AN6").WrapText = True



'provide initial value to row counter
i = 7
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("A" & i).Value = Nz(rs1!FirstOrderDate, "")
.Range("B" & i).Value = Nz(rs1!PreviousSupplyingBottlerFirstOrderDate, "")
.Range("C" & i).Value = Nz(rs1!DeactivatedDCCannotorderwithoutbeingreactivated, "")
.Range("D" & i).Value = Nz(rs1!DivestitureImplementationorSupplyingBottlertransferagreementimplementation, "")
.Range("E" & i).Value = Nz(rs1!FirstDeliveryDateCurrentSupplyingBottler, "")
.Range("F" & i).Value = Nz(rs1!FirstDeliveryDatePreviousSupplyingBottler, "")
.Range("G" & i).Value = Nz(rs1!DistributorDCSignedContract, "")
.Range("H" & i).Value = Nz(rs1!ARTMBroadlinerContractsSigned, "")
.Range("I" & i).Value = Nz(rs1!LARTM, "")
.Range("J" & i).Value = Nz(rs1!LARTMContractTier, "")
.Range("K" & i).Value = Nz(rs1!NARTM, "")
.Range("L" & i).Value = Nz(rs1!B2B, "")
.Range("M" & i).Value = Nz(rs1!ECOM, "")
.Range("N" & i).Value = Nz(rs1!Mcs, "")
.Range("O" & i).Value = Nz(rs1!DD, "")
.Range("P" & i).Value = Nz(rs1!Bids, "")
.Range("Q" & i).Value = Nz(rs1!AssignedARTMNationalRetailers, "")
.Range("R" & i).Value = Nz(rs1!DNSE, "")
.Range("S" & i).Value = Nz(rs1!NotesAboutDistributorDC, "")
.Range("T" & i).Value = Nz(rs1!DistributorOwnership, "")
.Range("U" & i).Value = Nz(rs1!DistributorDC, "")
.Range("V" & i).Value = Nz(rs1!DistributorDCShipToAddress, "")
.Range("W" & i).Value = Nz(rs1!DistributorDCCity, "")
.Range("X" & i).Value = Nz(rs1!DistributorDCState, "")
.Range("Y" & i).Value = Nz(rs1!DistributorDCZipCode, "")
.Range("Z" & i).Value = Nz(rs1!CurrentDistributorDCDeliveryOutletNum, "")
.Range("AA" & i).Value = Nz(rs1!PreviousDistributorDCDeliveryOutletNum, "")
.Range("AB" & i).Value = Nz(rs1!DistributorDCACN, "")
.Range("AC" & i).Value = Nz(rs1!DistributorDCWarehouseNum, "")
.Range("AD" & i).Value = Nz(rs1!WarehouseNumlength, "")
.Range("AE" & i).Value = Nz(rs1!EDIRCIandEDIProfileforCONA, "")
.Range("AF" & i).Value = Nz(rs1!OrderEDISetId, "")
.Range("AG" & i).Value = Nz(rs1!InvoiceEDISetID, "")
.Range("AH" & i).Value = Nz(rs1!CBSAccountNumber, "")
.Range("AI" & i).Value = Nz(rs1!OrderMethodusedbydistributorDCtoCBSManualorEDI850, "")
.Range("AJ" & i).Value = Nz(rs1!PreviousSupplyingBottler, "")
.Range("AK" & i).Value = Nz(rs1!PPLLocalRegion, "")
.Range("AL" & i).Value = Nz(rs1!CurrentBottlerdeliveringtodistributorDC, "")
.Range("AM" & i).Value = Nz(rs1!IndirectSalesLocation, "")
.Range("AN" & i).Value = Nz(rs1!DeliveryLocation, "")


i = i + 1
rs1.MoveNext

Loop



'Grid-lines: Interior
.Range("A6:AN" & i - 1).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("A6:AN" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous

'grid-line: heavy under column heading
.Range("A6:AN6").Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
.Range("A7:AN7").Borders(xlEdgeTop).Weight = XlBorderWeight.xlMedium
.Range("A6:AN" & i - 1).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
.Range("A6:AN" & i).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
.Range("A6:AN" & i - 1).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium



'Add conditional formatting - only 3 allowed
With .Range("c7:c" & i).FormatConditions.Add(xlCellValue, xlEqual, "=""X""")
.FormatConditions(1).Interior.Color = RGB(221, 217, 196)
End With



End With


SubExit:
On Error Resume Next

DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing

Exit Function

SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit

End Function




This post has been edited by roberjh: Jan 16 2017, 03:51 PM
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    23rd September 2017 - 06:29 PM