Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA Error in Excel

Status
Not open for further replies.
f0rg3tfu1

f0rg3tfu1

MIS
Aug 25, 2004
103
US
Hi guys,

Not a programmer here but I have to work with some VBA script that was legacy from the previous guy.

We added a new column, column I time and date field, into the spreadsheet and I made some adjustments but I am still getting a Type Mismatch error in line 405. I think its pretty easy im just not a programmer. Can anyone help?

Sub ProcessingPOsData()



Dim Connection As ADODB.Connection
Dim rs As New ADODB.Recordset
Set Connection = New ADODB.Connection

Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";Extended Properties=""Excel 12.0 Macro;HDR=YES;"""




'2A through 2C
Sheets("AP Working").Select
ActiveCell.SpecialCells(xlLastCell).Select
LastRow = getlastrow("AP Working", "A")
Rows(LastRow - 1 & ":" & LastRow).Select
Selection.Delete Shift:=xlUp
Rows("1:3").Select
Selection.Delete Shift:=xlUp

'2D - 2E
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


'2F
' Cells.Select
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Clear
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Add2 Key:=Range("D2:D" & getlastrow("AP Working", "A") _
' ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' With ActiveWorkbook.Worksheets("AP Working").Sort
' .SetRange Range("A1:AC" & getlastrow("AP Working", "A"))
' .Header = xlYes
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
' .Apply
' End With
'


Cells.Select
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
If ActiveSheet.FilterMode = False Then Selection.AutoFilter
Range("C7").Select
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Add Key:= _
Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


' Query = "select * from [AP Working$] order by [Vendor Name] asc"
' rs.Open Query, Connection
' Sheets("AP Working").Range("A2").CopyFromRecordset rs
' rs.Close




'2G through 2K
Cells.Select
Selection.ClearFormats
Rows("1:1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "PO# and Line #"
Range("A2").Select
ActiveCell.Formula = "=CONCATENATE(B2, "" - Line "",F2)"
Range("A3").Select

'2L through 2O
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & getlastrow("AP Working", "B"))
Range("A2:A" & getlastrow("AP Working", "A")).Select
Columns("A:A").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("B:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.FormatConditions.Delete
Range("B1").Select
ActiveCell.FormulaR1C1 = "Status Keyword"
Range("C1").Select
ActiveCell.FormulaR1C1 = "AP Notes"
Range("D1").Select
ActiveCell.FormulaR1C1 = "AP Contact"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Order Quantity not Accepted"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Received not Accepted"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Accepted not Vouchered"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Line Value Remaining"
Range("H2").Select

'2P through 2R
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("S:T").Select
Columns("S:T").EntireColumn.AutoFit
Selection.ColumnWidth = 32.71
Range("U:U,Y:Y,AA:AA,AC:AC,AE:AE").Select
Range("AE1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15847394
.TintAndShade = 0
'.Patte
End With

'2S
Range("V:V,W:W,X:X,Z:Z,AB:AB,AD:AD").Select
Range("AD1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

'2T through 2V
Range("E2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=U2-AA2"
Range("F2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=Y2-AA2-AE2"
Range("G2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=AA2-AC2"
Range("H2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=X2-AD2"
Range("H3").Select
Range("E2:H2").Select
Selection.AutoFill Destination:=Range("E2:H" & getlastrow("AP Working", "A"))
Range("E2:H" & getlastrow("AP Working", "A")).Select

For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
VendorID = Range("K" & cell.Row).Value
'Debug.Print (VendorID)
If IsError(Application.Match(Left(VendorID, 3) & "*", ThisWorkbook.Sheets("Setup").Range("A:A"), 0)) Then
'Debug.Print (Left(VendorID, 3))
'If Left(VendorID, 3) <> "190" And Left(VendorID, 3) <> "142" And Left(VendorID, 3) <> "126" And Left(VendorID, 3) <> "148" Then
Range("B" & cell.Row).Value = "NOT HUNTSVILLE"
Range("C" & cell.Row).Value = "NOT HUNTSVILLE"
End If
Next cell

'3D - 3F
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantityNotAccepted = Range("E" & cell.Row).Value
ReceivedNotAccepted = Range("F" & cell.Row).Value
AcceptedNotVouchered = Range("G" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
StatusKeyword = Range("B" & cell.Row).Value
LineStatusType = Range("N" & cell.Row).Value
[highlight #FCE94F] If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "C" Then[/highlight]
Range("B" & cell.Row).Value = "CLOSED"
Range("C" & cell.Row).Value = "CLOSED: If there was a Quantity, all have been R/A, all has been vouchered and pd and $0 line value remaining"
End If

If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "V" Then
Range("B" & cell.Row).Value = "VOIDED"
Range("C" & cell.Row).Value = "PO Line Status is ""V"" no further action required"
End If

If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "S" Then
Range("B" & cell.Row).Value = "EXCLUDE"
Range("C" & cell.Row).Value = "Exclude PO Line: Processed"
End If
Next cell

'3G - 3G3
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantity = Range("U" & cell.Row).Value
OrderQuantityNotAccepted = Range("E" & cell.Row).Value
ReceivedNotAccepted = Range("F" & cell.Row).Value
AcceptedNotVouchered = Range("G" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
StatusKeyword = Range("B" & cell.Row).Value
LineStatusType = Range("N" & cell.Row).Value

If OrderQuantity <> 0 And OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And Abs(LineValueRemaining) <= 100 And Len(StatusKeyword) = 0 Then
If LineStatusType = "S" Or LineStatusType = "O" Then
Range("B" & cell.Row).Value = "EXCLUDE"
Range("C" & cell.Row).Value = "Exclude PO Line: Processed)"
End If
If LineStatusType = "C" Then
Range("B" & cell.Row).Value = "CLOSED"
Range("C" & cell.Row).Value = "CLOSED: All quantities have been received, accepted and vouchered, line value remaining is within the $100/line threshold (this discrepancy would be due to such charges as tax, shipping and rounding issues)"
End If
End If
Next cell

'3H - 3J
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantity = Range("U" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
LineStatusType = Range("N" & cell.Row).Value
If OrderQuantity = 0 And LineValueRemaining <= 0 And LineValueRemaining > -101 Then
If LineStatusType = "O" Or LineStatusType = "S" Then
Range("B" & cell.Row).Value = "EXCLUDE"
Range("C" & cell.Row).Value = "Exclude PO Line: Processed"
End If
If LineStatusType = "C" Then
Range("B" & cell.Row).Value = "CLOSED"
Range("C" & cell.Row).Value = "CLOSED: PO line has been vouchered, line value remaining is within the $100/line threshold (this discrepancy would be due to such charges such as tax, shipping and rounding issues)"
End If
End If
Next cell
End Sub
Sub UpdateVendorContactList()
Set Macrowb = Application.ActiveWorkbook
Set APVendorContactListWB = Application.Workbooks.Open(Sheet1.TextBoxAPVendorContactList)

flag = 0
For Each ws In APVendorContactListWB.Worksheets
If ws.Name = "AP Vendor and Contact" Then flag = 1
Next ws
If flag = 0 Then
MsgBox "Script did not find a tab named 'AP Vendor and Contact' in the Vendor Contact List workbook." & vbNewLine & "Please make sure such tab exists in the Workbook you selected and re-run step 1.", vbCritical
End
End If

If flag = 1 Then
Macrowb.Activate
Macrowb.Sheets("AP Working").Range("D2").Formula = "=VLOOKUP(K2,'[" & APVendorContactListWB.Name & "]AP Vendor and Contact'!$A:$B,2,FALSE)"
Range("D2").Select

Selection.AutoFill Destination:=Range("D2:D" & getlastrow("AP Working", "A"))
Range("D2:D" & getlastrow("AP Working", "A")).Select

APVendorContactListWB.Activate
APVendorContactLastRow = getlastrow("AP Vendor and Contact", "A")

Macrowb.Activate
Sheets("AP Working").Select

For Each cell In Range("D2:D" & getlastrow("AP Working", "A"))
If CStr(cell.Value) = "Error 2042" Then
MissingVendor = Range("K" & cell.Row).Value
APVendorContactListWB.Sheets("AP Vendor and Contact").Range("A" & APVendorContactLastRow + 1).Value = MissingVendor
'APVendorContactListWB.Sheets("AP Vendor and Contact").Range("A" & APVendorContactLastRow + 1).Color = 65535
APVendorContactListWB.Sheets("AP Vendor and Contact").Range("B" & APVendorContactLastRow + 1).Value = "UPDATE THIS AP CONTACT"
'APVendorContactListWB.Sheets("AP Vendor and Contact").Range("B" & APVendorContactLastRow + 1).Color = 65535

APVendorContactLastRow = APVendorContactLastRow + 1
End If
Next cell

Sheets("Setup").Select


Application.ScreenUpdating = True

APVendorContactListWB.Activate
Sheets("AP Vendor and Contact").Select
Range("A" & getlastrow("AP Vendor and Contact", "A")).Select
'MsgBox getlastrow("AP Vendor and Contact", "A")

MsgBox "Step 1 complete." & vbNewLine & vbNewLine & "Now please update contacts for the new Vendor IDs added at the end of list on 'AP Vendor and Contact' tab in Vendor Contacts workbook." & vbNewLine & _
"Save changes, close Vendor Contacts workbook, and run Step 2.", vbInformation



End If


End Sub
 
 https://files.engineering.com/getfile.aspx?folder=f124ea9a-67c5-4159-8d16-b13f111f3626&file=sc.PNG
Sort by date Sort by votes
Check if after adding column you have proper columns references.

Are variables OrderQuantityNotAccepted and other declared? If so, how?

When the code breaks in a line due to error, hover over variables and values in the line. You should be able to see values involved. A line with error (cell.Row) should also be visible.

Add:
[tt]Debug.Print cell.Row
Debug.Print OrderQuantityNotAccepted = 0
' and other conditions from line with error[/tt]
and check in immediate window which condition raises the error.

combo
 
Upvote 0 Downvote
We added a new column, column I
Click to expand...

Did you INSERT that column?

If so, your VBA code references column east of I, for instance
Code: 
'3D - 3F
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantityNotAccepted = Range("E" & cell.Row).Value
ReceivedNotAccepted = Range("F" & cell.Row).Value
AcceptedNotVouchered = Range("G" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
StatusKeyword = Range("B" & cell.Row).Value
[b]LineStatusType = Range("N" & cell.Row).Value[/b]
If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "C" Then
What kind of data is now in column N?
This may be where you miss match is.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!
 
Upvote 0 Downvote
Combo,

Thanks for the reply but this is a bit beyond me. I did change the cell reference in the data validation module and it works. I added in Column I where I have highlighted but I don't see any other references to column I. Here is the entire module... the error that OrderQuantityNotAccepted is giving is 2015.

Sub Process1Step()
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = False

Initialize
CopyDataFromCognos
ProcessingPOsData
UpdateVendorContactList

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Process2Step()

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = False
If IsWorkBookOpen(Sheet1.TextBoxAPVendorContactList) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxAPVendorContactList
Exit Sub
End If

Step2PreFormatting
CopyingNonBlanksIntoOtherTab
BringInfoFromPriorPOReport ("Other")
BringInfoFromPriorPOReport ("AP Working")

FormatData
createCloseReport

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Sheets("AP Working").Select
Range("A2").Select
Sheets("Setup").Select
MsgBox "Script run complete. Close POs file is saved in the same folder where this Workbook is located."

End Sub

Sub ValidateInputFiles()
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
If Len(Dir(Sheet1.TextBoxCognosReport1)) = 0 Then
MsgBox "Cannot find Cognos 'Purchase Orders without Receipt Info file'. Please make sure you selected existing file."
End
End If
If Len(Dir(Sheet1.TextBoxAPVendorContactList)) = 0 Then
MsgBox "Cannot find 'AP Vendor - Contact List' file. Please make sure you selected existing file."
End
End If
If Len(Dir(Sheet1.TextBoxLastPOReport)) = 0 Then
MsgBox "Cannot find 'Last PO Report' file. Please make sure you selected existing file."
End
End If

If IsWorkBookOpen(Sheet1.TextBoxCognosReport1) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxCognosReport1
End
End If
If IsWorkBookOpen(Sheet1.TextBoxAPVendorContactList) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxAPVendorContactList
End
End If
If IsWorkBookOpen(Sheet1.TextBoxLastPOReport) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxLastPOReport
End
End If

Set Macrowb = Application.ActiveWorkbook
Set APVendorContactListWB = Application.Workbooks.Open(Sheet1.TextBoxAPVendorContactList)
flag = 0
For Each ws In APVendorContactListWB.Worksheets
If ws.Name = "AP Vendor and Contact" Then flag = 1
Next ws
If flag = 0 Then
MsgBox "Script did not find a tab named 'AP Vendor and Contact' in the Vendor Contact List workbook." & vbNewLine & "Please make sure such tab exists in the Workbook you selected.", vbCritical
End
End If
APVendorContactListWB.Close

Set LastPOReport = Application.Workbooks.Open(Sheet1.TextBoxLastPOReport)
flag = 0
For Each ws In LastPOReport.Worksheets
If ws.Name = "AP Working" Then flag = flag + 1
If ws.Name = "Other" Then flag = flag + 1
Next ws
If flag < 2 Then
MsgBox "Script did not find tabs named 'AP Working' and 'Other' in the Last PO Report." & vbNewLine & "Please make sure such tabs exists in the Workbook you selected.", vbCritical
End
End If
LastPOReport.Close

CognosWBErrors = 0
Set CognosWB = Application.Workbooks.Open(Sheet1.TextBoxCognosReport1)
If CognosWB.Sheets(ActiveSheet.Name).Range("A4") <> "P/O Number" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("B4") <> "Buyer ID" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("C4") <> "Vendor ID" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("D4") <> "Vendor Name" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("E4") <> "Line Number" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("F4") <> "Line Status Type" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("G4") <> "Line Desc" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("H4") <> "Due Date" Then CognosWBErrors = CognosWBErrors + 1
[highlight ]If CognosWB.Sheets(ActiveSheet.Name).Range("I4") <> "Entry Date/Time" Then CognosWBErrors = CognosWBErrors + 1[/highlight]
If CognosWB.Sheets(ActiveSheet.Name).Range("J4") <> "Approval Date" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("K4") <> "Ship Via" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("L4") <> "Deliver To" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("M4") <> "PO Line Notes" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("N4") <> "Order Quantity" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("O4") <> "Gross Unit Cost" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("P4") <> "Sales Tax Amount" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("Q4") <> "Line Total Amount" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("R4") <> "Received Qty" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("S4") <> "Received Amount" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("T4") <> "Accepted Qty" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("U4") <> "Accepted Amount" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("V4") <> "Vouchered Qty" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("W4") <> "Vouchered Amount" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("X4") <> "PO Line Rejected Quantity" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("Y4") <> "PO Line Rejected Amount" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("Z4") <> "Account ID" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("AA4") <> "Account Name" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("AB4") <> "Organization ID" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("AC4") <> "Project ID" Then CognosWBErrors = CognosWBErrors + 1
If CognosWB.Sheets(ActiveSheet.Name).Range("AD4") <> "Project Name" Then CognosWBErrors = CognosWBErrors + 1

If CognosWBErrors > 0 Then
CognosWB.Close
MsgBox "Columns included into 'Purchase Orders without Receipt Info' report DO NOT match the list and order of the columns script can work with. Please refer to PO Report Instruction Guide tab for the list of columns that should be included into report. Please do not include extra columns.", vbCritical
End
End If
CognosWB.Close

MsgBox "No problems found with Input files"

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

Sub Initialize()
'Checking if files exist
If Len(Dir(Sheet1.TextBoxCognosReport1)) = 0 Then
MsgBox "Cannot find Cognos 'Purchase Orders without Receipt Info file'. Please make sure you selected existing file."
End
End If
If Len(Dir(Sheet1.TextBoxAPVendorContactList)) = 0 Then
MsgBox "Cannot find 'AP Vendor - Contact List' file. Please make sure you selected existing file."
End
End If
If Len(Dir(Sheet1.TextBoxLastPOReport)) = 0 Then
MsgBox "Cannot find 'Last PO Report' file. Please make sure you selected existing file."
End
End If

If IsWorkBookOpen(Sheet1.TextBoxCognosReport1) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxCognosReport1
End
End If
If IsWorkBookOpen(Sheet1.TextBoxAPVendorContactList) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxAPVendorContactList
End
End If
If IsWorkBookOpen(Sheet1.TextBoxLastPOReport) Then
MsgBox "Please close following workbook before proceeding: " & Sheet1.TextBoxLastPOReport
End
End If

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

'Deleting extra tabs and adding needed ones
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Setup" And ws.Name <> "PO Report Instruction Guide" Then ws.Delete
Next
Set ws1 = Sheets.Add(After:=ActiveSheet)
ws1.Name = "AP Working"
Set ws1 = Sheets.Add(After:=ActiveSheet)
ws1.Name = "Other"
End Sub
Sub CopyDataFromCognos()
'Opening Cognos report and copying data into AP Working tab. Closing Cognos report after
Set Macrowb = Application.ActiveWorkbook
Set CognosWB = Application.Workbooks.Open(Sheet1.TextBoxCognosReport1)

Cells.Select
Selection.Copy
Macrowb.Activate
Sheets("AP Working").Select
Range("A1").Select
ActiveSheet.Paste
CognosWB.Close
End Sub
Sub ProcessingPOsData()



Dim Connection As ADODB.Connection
Dim rs As New ADODB.Recordset
Set Connection = New ADODB.Connection

Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";Extended Properties=""Excel 12.0 Macro;HDR=YES;"""




'2A through 2C
Sheets("AP Working").Select
ActiveCell.SpecialCells(xlLastCell).Select
LastRow = getlastrow("AP Working", "A")
Rows(LastRow - 1 & ":" & LastRow).Select
Selection.Delete Shift:=xlUp
Rows("1:3").Select
Selection.Delete Shift:=xlUp

'2D - 2E
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


'2F
' Cells.Select
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Clear
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Add2 Key:=Range("D2:D" & getlastrow("AP Working", "A") _
' ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' With ActiveWorkbook.Worksheets("AP Working").Sort
' .SetRange Range("A1:AC" & getlastrow("AP Working", "A"))
' .Header = xlYes
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
' .Apply
' End With
'


Cells.Select
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
If ActiveSheet.FilterMode = False Then Selection.AutoFilter
Range("C7").Select
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Add Key:= _
Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


' Query = "select * from [AP Working$] order by [Vendor Name] asc"
' rs.Open Query, Connection
' Sheets("AP Working").Range("A2").CopyFromRecordset rs
' rs.Close




'2G through 2K
Cells.Select
Selection.ClearFormats
Rows("1:1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "PO# and Line #"
Range("A2").Select
ActiveCell.Formula = "=CONCATENATE(B2, "" - Line "",F2)"
Range("A3").Select

'2L through 2O
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & getlastrow("AP Working", "B"))
Range("A2:A" & getlastrow("AP Working", "A")).Select
Columns("A:A").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("B:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.FormatConditions.Delete
Range("B1").Select
ActiveCell.FormulaR1C1 = "Status Keyword"
Range("C1").Select
ActiveCell.FormulaR1C1 = "AP Notes"
Range("D1").Select
ActiveCell.FormulaR1C1 = "AP Contact"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Order Quantity not Accepted"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Received not Accepted"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Accepted not Vouchered"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Line Value Remaining"
Range("H2").Select

'2P through 2R
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("S:T").Select
Columns("S:T").EntireColumn.AutoFit
Selection.ColumnWidth = 32.71
Range("U:U,Y:Y,AA:AA,AC:AC,AE:AE").Select
Range("AE1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15847394
.TintAndShade = 0
'.Patte
End With

'2S
Range("V:V,W:W,X:X,Z:Z,AB:AB,AD:AD").Select
Range("AD1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

'2T through 2V
Range("E2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=U2-AA2"
Range("F2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=Y2-AA2-AE2"
Range("G2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=AA2-AC2"
Range("H2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=X2-AD2"
Range("H3").Select
Range("E2:H2").Select
Selection.AutoFill Destination:=Range("E2:H" & getlastrow("AP Working", "A"))
Range("E2:H" & getlastrow("AP Working", "A")).Select

For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
VendorID = Range("K" & cell.Row).Value
'Debug.Print (VendorID)
If IsError(Application.Match(Left(VendorID, 3) & "*", ThisWorkbook.Sheets("Setup").Range("A:A"), 0)) Then
'Debug.Print (Left(VendorID, 3))
'If Left(VendorID, 3) <> "190" And Left(VendorID, 3) <> "142" And Left(VendorID, 3) <> "126" And Left(VendorID, 3) <> "148" Then
Range("B" & cell.Row).Value = "NOT HUNTSVILLE"
Range("C" & cell.Row).Value = "NOT HUNTSVILLE"
End If
Next cell

'3D - 3F
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantityNotAccepted = Range("E" & cell.Row).Value
ReceivedNotAccepted = Range("F" & cell.Row).Value
AcceptedNotVouchered = Range("G" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
StatusKeyword = Range("B" & cell.Row).Value
LineStatusType = Range("N" & cell.Row).Value
If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "C" Then
Range("B" & cell.Row).Value = "CLOSED"
Range("C" & cell.Row).Value = "CLOSED: If there was a Quantity, all have been R/A, all has been vouchered and pd and $0 line value remaining"
End If

If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "V" Then
Range("B" & cell.Row).Value = "VOIDED"
Range("C" & cell.Row).Value = "PO Line Status is ""V"" no further action required"
End If

If OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And LineValueRemaining = 0 And Len(StatusKeyword) = 0 And LineStatusType = "S" Then
Range("B" & cell.Row).Value = "EXCLUDE"
Range("C" & cell.Row).Value = "Exclude PO Line: Processed"
End If
Next cell

'3G - 3G3
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantity = Range("U" & cell.Row).Value
OrderQuantityNotAccepted = Range("E" & cell.Row).Value
ReceivedNotAccepted = Range("F" & cell.Row).Value
AcceptedNotVouchered = Range("G" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
StatusKeyword = Range("B" & cell.Row).Value
LineStatusType = Range("N" & cell.Row).Value

If OrderQuantity <> 0 And OrderQuantityNotAccepted = 0 And ReceivedNotAccepted = 0 And AcceptedNotVouchered = 0 And Abs(LineValueRemaining) <= 100 And Len(StatusKeyword) = 0 Then
If LineStatusType = "S" Or LineStatusType = "O" Then
Range("B" & cell.Row).Value = "EXCLUDE"
Range("C" & cell.Row).Value = "Exclude PO Line: Processed)"
End If
If LineStatusType = "C" Then
Range("B" & cell.Row).Value = "CLOSED"
Range("C" & cell.Row).Value = "CLOSED: All quantities have been received, accepted and vouchered, line value remaining is within the $100/line threshold (this discrepancy would be due to such charges as tax, shipping and rounding issues)"
End If
End If
Next cell

'3H - 3J
For Each cell In Range("A2:A" & getlastrow("AP Working", "A"))
OrderQuantity = Range("U" & cell.Row).Value
LineValueRemaining = Range("H" & cell.Row).Value
LineStatusType = Range("N" & cell.Row).Value
If OrderQuantity = 0 And LineValueRemaining <= 0 And LineValueRemaining > -101 Then
If LineStatusType = "O" Or LineStatusType = "S" Then
Range("B" & cell.Row).Value = "EXCLUDE"
Range("C" & cell.Row).Value = "Exclude PO Line: Processed"
End If
If LineStatusType = "C" Then
Range("B" & cell.Row).Value = "CLOSED"
Range("C" & cell.Row).Value = "CLOSED: PO line has been vouchered, line value remaining is within the $100/line threshold (this discrepancy would be due to such charges such as tax, shipping and rounding issues)"
End If
End If
Next cell
End Sub
Sub UpdateVendorContactList()
Set Macrowb = Application.ActiveWorkbook
Set APVendorContactListWB = Application.Workbooks.Open(Sheet1.TextBoxAPVendorContactList)

flag = 0
For Each ws In APVendorContactListWB.Worksheets
If ws.Name = "AP Vendor and Contact" Then flag = 1
Next ws
If flag = 0 Then
MsgBox "Script did not find a tab named 'AP Vendor and Contact' in the Vendor Contact List workbook." & vbNewLine & "Please make sure such tab exists in the Workbook you selected and re-run step 1.", vbCritical
End
End If

If flag = 1 Then
Macrowb.Activate
Macrowb.Sheets("AP Working").Range("D2").Formula = "=VLOOKUP(K2,'[" & APVendorContactListWB.Name & "]AP Vendor and Contact'!$A:$B,2,FALSE)"
Range("D2").Select

Selection.AutoFill Destination:=Range("D2:D" & getlastrow("AP Working", "A"))
Range("D2:D" & getlastrow("AP Working", "A")).Select

APVendorContactListWB.Activate
APVendorContactLastRow = getlastrow("AP Vendor and Contact", "A")

Macrowb.Activate
Sheets("AP Working").Select

For Each cell In Range("D2:D" & getlastrow("AP Working", "A"))
If CStr(cell.Value) = "Error 2042" Then
MissingVendor = Range("K" & cell.Row).Value
APVendorContactListWB.Sheets("AP Vendor and Contact").Range("A" & APVendorContactLastRow + 1).Value = MissingVendor
'APVendorContactListWB.Sheets("AP Vendor and Contact").Range("A" & APVendorContactLastRow + 1).Color = 65535
APVendorContactListWB.Sheets("AP Vendor and Contact").Range("B" & APVendorContactLastRow + 1).Value = "UPDATE THIS AP CONTACT"
'APVendorContactListWB.Sheets("AP Vendor and Contact").Range("B" & APVendorContactLastRow + 1).Color = 65535

APVendorContactLastRow = APVendorContactLastRow + 1
End If
Next cell

Sheets("Setup").Select


Application.ScreenUpdating = True

APVendorContactListWB.Activate
Sheets("AP Vendor and Contact").Select
Range("A" & getlastrow("AP Vendor and Contact", "A")).Select
'MsgBox getlastrow("AP Vendor and Contact", "A")

MsgBox "Step 1 complete." & vbNewLine & vbNewLine & "Now please update contacts for the new Vendor IDs added at the end of list on 'AP Vendor and Contact' tab in Vendor Contacts workbook." & vbNewLine & _
"Save changes, close Vendor Contacts workbook, and run Step 2.", vbInformation



End If


End Sub

Sub Step2PreFormatting()
Set Macrowb = Application.ActiveWorkbook
Set APVendorContactListWB = Application.Workbooks.Open(Sheet1.TextBoxAPVendorContactList)
'Recalculating formulas in column D after adding Vendor Contacts
Macrowb.Activate
Sheets("AP Working").Select
Sheets("AP Working").Range("D2").Formula = "=VLOOKUP(K2,'[" & APVendorContactListWB.Name & "]AP Vendor and Contact'!$A:$B,2,FALSE)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & getlastrow("AP Working", "A"))
Range("D2:D" & getlastrow("AP Working", "A")).Select
ActiveSheet.Calculate
APVendorContactListWB.Close

'Pasting values instead of formulas in AP Contact column
Sheets("AP Working").Select
Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("D12").Select


End Sub
Sub CopyingNonBlanksIntoOtherTab()
Sheets("AP Working").Select
Cells.Select
'MsgBox "test"

If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
If ActiveSheet.FilterMode = False Then Selection.AutoFilter
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Add Key:= _
Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'MsgBox "test"


' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Clear
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Add2 Key:=Range("B:B" _
' ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' With ActiveWorkbook.Worksheets("AP Working").Sort
' .SetRange Range("A:BA")
' .Header = xlYes
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
' .Apply
' End With

Range("A1").Select
LastBRow = getlastrow("AP Working", "B")

Range("A2:AK" & getlastrow("AP Working", "B")).Select
Selection.Cut
Sheets("Other").Select
Range("A2").Select
ActiveSheet.Paste

'Pasting caption
Sheets("AP Working").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Other").Select
Range("A1").Select
ActiveSheet.Paste

Sheets("AP Working").Select
Rows("2:" & LastBRow).Select
Selection.Delete
End Sub
Sub BringInfoFromPriorPOReport(tabname As Variant)
Set Macrowb = Application.ActiveWorkbook
Set LastPOReport = Application.Workbooks.Open(Sheet1.TextBoxLastPOReport)
Macrowb.Activate

flag = 0
For Each ws In LastPOReport.Worksheets
If ws.Name = "AP Working" Then flag = flag + 1
If ws.Name = "Other" Then flag = flag + 1
Next ws
If flag < 2 Then
MsgBox "Script did not find tabs named 'AP Working' and 'Other' in the Last PO Report." & vbNewLine & "Please make sure such tabs exists in the Workbook you selected and re-run step 1 and 2.", vbCritical
End
End If

'Bringing formulas from tabname tab from prior PO report
'Bringing Formulas
Sheets("AP Working").Select
Range("B2").Select


'MsgBox tabname
LastPOReportFilePath = Sheet1.TextBoxLastPOReport


ActiveCell.Formula = "=IF(NOT(ISNA(VLOOKUP(A2,'[" & LastPOReport.Name & "]" & tabname & "'!$A:$C,2,FALSE))),VLOOKUP(A2,'[" & LastPOReport.Name & "]" & tabname & "'!$A:$C,2,FALSE),"""")"
Range("C2").Select
ActiveCell.Formula = _
"=IF(NOT(ISNA(VLOOKUP(A2,'[" & LastPOReport.Name & "]" & tabname & "'!$A:$C,3,FALSE))),VLOOKUP(A2,'[" & LastPOReport.Name & "]" & tabname & "'!$A:$C,3,FALSE),"""")"

Range("B2:C2").Select
Selection.AutoFill Destination:=Range("B2:C" & getlastrow("AP Working", "A"))

Range("B2:C" & getlastrow("AP Working", "A")).Select
Sheets("AP Working").Select
'Pasting values
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False



'Sorting by column B and pasting into others
' Cells.Select
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Clear
' ActiveWorkbook.Worksheets("AP Working").Sort.SortFields.Add2 Key:=Range( _
' "B2:B" & getlastrow("AP Working", "A")), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
' xlSortNormal
' With ActiveWorkbook.Worksheets("AP Working").Sort
' .SetRange Range("A1:AK" & getlastrow("AP Working", "A"))
' .Header = xlYes
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
' .Apply
' End With

'
'MsgBox "test1"
Cells.Select

ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Add Key:= _
Range("B:B"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With




Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D2").Select
ActiveCell.Formula = "=LEN(B2)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & getlastrow("AP Working", "A"))
Range("D2:D" & getlastrow("AP Working", "A")).Select
LastBRow = WorksheetFunction.CountIfs(Range("D:D"), ">1") + 1

Columns("D:D").Select
Selection.Delete Shift:=xlToLeft

If LastBRow > 1 Then
Range("A2:AK" & LastBRow).Select
Selection.Cut
Sheets("Other").Select
Range("A" & getlastrow("Other", "A") + 1).Select
ActiveSheet.Paste
Sheets("AP Working").Select
Rows("2:" & LastBRow).Select
Selection.Delete
End If

'Sorting by column C and pasting into others
'MsgBox "test2"
Cells.Select
'Selection.AutoFilter

ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("AP Working").AutoFilter.Sort.SortFields.Add Key:=Range( _
"C:C"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("AP Working").Sort
.SetRange Range("A:AK")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D2").Select
ActiveCell.Formula = "=LEN(C2)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & getlastrow("AP Working", "A"))
Range("D2:D" & getlastrow("AP Working", "A")).Select
LastBRow = WorksheetFunction.CountIfs(Range("D:D"), ">1") + 1

Columns("D:D").Select
Selection.Delete Shift:=xlToLeft

If LastBRow > 1 Then
Range("A2:AK" & LastBRow).Select
Selection.Cut
Sheets("Other").Select
Range("A" & getlastrow("Other", "A") + 1).Select
ActiveSheet.Paste
Sheets("AP Working").Select
Rows("2:" & LastBRow).Select
Selection.Delete
End If


LastPOReport.Close
End Sub

Sub createCloseReport()

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set ws = Sheets.Add(After:=ActiveSheet)

Dim Connection As ADODB.Connection
Dim rs As New ADODB.Recordset
Set Connection = New ADODB.Connection


Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";Extended Properties=""Excel 12.0 Macro;HDR=YES;"""

Query = "select * from [Other$] where [Status Keyword] = 'EXCLUDE'"
rs.Open Query, Connection
ws.Range("A2").CopyFromRecordset rs
rs.Close



Sheets("AP Working").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ws.Select
Range("A1").Select
ActiveSheet.Paste
Sheets("AP Working").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
ws.Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows("1:1").Select
Selection.AutoFilter
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Range("A1").Select


ws.Select
ws.Copy
'MsgBox ThisWorkbook.Path & "\" & Sheet1.TextBoxClosePOFile
ActiveWorkbook.SaveAs FileName:= _
ThisWorkbook.Path & "\" & Sheet1.TextBoxClosePOFile, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close

ws.Delete



Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub FormatData()
Sheets("AP Working").Select
Formatting1
Sheets("Other").Select
Formatting1
Columns("C:C").ColumnWidth = 32.43
Sheets("Setup").Select
End Sub
 
Upvote 0 Downvote
Check my post above, just a few minutes before your latest post.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!
 
Upvote 0 Downvote
Please be clear, concise and complete.

We cannot see your workbook structure and content. When you say that the datatype is "text," exactly what are you referring to?

I was drawing your attention to column N. If you INSERTED a new column I, then all the columns originally from I and to the right would be one column further right and column N would become column O and column M would become column N.

Examples are often helpful.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!
 
Upvote 0 Downvote
I noticed that you deleted your question and from that I ASSUME (hopefully correctly) that you did indeed INSERT column I and that all the column references to columns greater than I would need to be changed in your code.

In light of this assumed fact, you have uncovered a weakness in the code that you unfortunately inherited. The accounting workbook was very poorly designed and coded, making it labor intensive to maintain. That's what you have been experiencing.



Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!
 
Upvote 0 Downvote
Hi Skip, sorry I was typing as you were replying so my apologize and yes I did delete that post...

Yes you are correct I added column "I" (which is a time/date field) to the upload sheet as I stated in my original question.

I am just trying to fix it now... I will change any reference after column I to one letter down and hopefully that will fix it. I am open to other ideas, unfortunately I inherited this thing.
 
Upvote 0 Downvote
If this is mission critical, you ma have a problem.

Fix the references that were created by INSERTING a column in your table.

OR...

...go back to the way it was and put your DateTime column in the first empty column to the right of your table. That way, no references need to be changed.

In the future, be very careful about ANY changes to your accounting workbook. It's not a trivial task to maintain such a workbook.

You probably need a very competent Excel/VBA programmer/analyst to design and code. Chances are, this is not the only Excel/VBA workbook that will need attention at some time in the future.


Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!
 
Upvote 0 Downvote
Hey Skip thank you, I am doing exactly what you said by putting the new column at the other end of the spreadsheet... I am actually a reporting analyst/SQL guy and the person I took over was a VBA guy. Unfortunately, you download the CSV of this report from our reporting system and then load it into excel using this Macro which spits out a different file to upload elsewhere... it's a total mess.

I completely agree with you, there was a single point of failure that I am trying to remedy. This spreadsheet is a critical task, but not time-sensitive yet.

I appreciate your help a ton, if we can just get this working I think I can move forward with everything else. I am going to change my report to insert the column at the very end so with any luck that will fix at least part of it.

Ill be in touch!
 
Upvote 0 Downvote
Unfortunately, you download the CSV of this report from our reporting system and then load it into excel using this Macro which spits out a different file to upload elsewhere
Click to expand...

You may be able to directly access the data you need from your corporate database to Excel using Data > Get External Data > From... using SQL and Refresh on demand.

I used Microsoft Query which created a QueryTable on the sheet that is a ListObject. This means that the resulting table has properties that make it easier to access and manipulate the data by using table header names rather than A1 references. I've been retired for nearly 10 years, but I did data acquisition from Oracle, DB2, Access, SQL Server and more in Excel for data analysis and reporting for 2 decades.

Combo, who initially responded, can provide additional guidance with other data acquisition methods that I'm not up on.

I noticed that there's code in your procedure that grabs data from worksheets AP Working and Other and copies them somewhere else. That could be done directly from the external data source. But I haven't done that for nearly a decade. But what I previously suggested is probably what you ought to do. Make minimum changes that do not impact the basic structure. If you're gonna be the SQL/VBA guy, you'll need to get educated on Excel/VBA. This forum plus Forum68 will be a great resource.

Good luck!

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!
 
Upvote 0 Downvote
Long time ago I inherited a similarly designed code: small changes in code by macro recorder, full of 'Select', 'Activate', 'With Selection' and 90% of settings unchanged by the user. Such code was hardly readible. To make things worse, a set of reports from templates was generated in the same way. It took me a long time to convert the application to single sheet user interface and in VBA project, extracting common procedures and removing all selections from code.

I agree with Skip that "a very competent Excel/VBA programmer/analyst" should rewrite the full process. As a result you should have more clear, solid and flexible application. When working with (external) data, typically there are three steps: input, preprocessing and reporting. With contemporary Excel tools (Power Query queries) two first steps can be completed in Power Query environment, VBA can only automate it and prepare output data. Power Query, of course, is an option, but why filling a column with LEN function or using VLOOKUP when T[tt]ext.Length[/tt] or [tt]Table.NestedJoin[/tt] with a set of [tt]JoinKind[/tt] are accessible using mouse and maybe CTRL key only, and act with whole columns?

combo
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
552
remeng
remeng
remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
1K
dhookom
dhookom
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
310
combo
combo
xwb
  • Locked
  • Helpful tip
Performing VBA operations in other languages
Replies
1
Views
223
strongm
strongm
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
434
hermanlaksko
hermanlaksko

Part and Inventory Search

Sponsor

Back
Top