You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
199 lines
7.5 KiB
199 lines
7.5 KiB
|
|
Sub OnHoldReconcile()
|
|
|
|
Dim gpFull As Range
|
|
Dim GpFilteredPaste As Range
|
|
Dim gpFiltered As Range
|
|
|
|
|
|
|
|
' Get the values in the GP (Great PLains) sheet
|
|
Set gpFull = SelectRange("GP", "A", 2, "L")
|
|
Set GpFilteredPaste = WorkSheets("GPFiltered").Range("A2")
|
|
Set gpFilered = FilterGreatPlains(gpFull, GpFilteredPaste)
|
|
|
|
Dim gpContracts As Range
|
|
gpContracts = gpFileted.Range("H:H")
|
|
NormalizeContractNumbers gpContracts
|
|
|
|
|
|
End Sub
|
|
Sub PasteRows(sourceRange As Range, sourceRows() As Long, destRange As Range)
|
|
' Copies specific rows from a source range to a destination range.
|
|
|
|
' Parameters:
|
|
' sourceRange: The range of data to copy rows from.
|
|
' sourceRows: An array of row numbers to copy from the source range.
|
|
' destRange: The destination range to paste the copied rows.
|
|
|
|
Dim srcRow As Range
|
|
Dim destRow As Range
|
|
|
|
' Loop through each row in the sourceRows array
|
|
For I = 0 To UBound(sourceRows)
|
|
' Define the row to copy from the source range
|
|
Set srcRow = sourceRange.Rows(sourceRows(I) - sourceRange.Row + 1)
|
|
|
|
' Define the row to paste into the destination range
|
|
Set destRow = destRange.Offset(I)
|
|
|
|
' Copy the row from the source range to the destination range
|
|
srcRow.Copy destRow
|
|
Next I
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------
|
|
'NormalizeContractNumbers Sub | Normalizes contract numbers in a given range by removing whitespace or words
|
|
'
|
|
'@param columnRange | The range of cells containing the contract numbers to be normalized
|
|
'
|
|
'@return | None
|
|
'-------------------------------------------------------------------
|
|
Sub NormalizeContractNumbers(columnRange As Range)
|
|
|
|
Dim cnRegex As String
|
|
' Regex to remove whitespace or words
|
|
' Matches contracts with & without the schedule id
|
|
cnRegex = "\d{7}(-\d{3})?"
|
|
|
|
' Find the last filled Row
|
|
Dim lastRow As Long
|
|
' Subtract one to exclude the header row
|
|
lastRow = columnRange.End(xlUp).Row - 1
|
|
|
|
Dim cell As Range
|
|
' I = 2 to avoid header row
|
|
For I = 2 To lastRow
|
|
' Returns a normalized contract number, or the orginal value passed in
|
|
cell.Value = ExtractMatch(cnRegex, cell.Value, room:=True) ' room: ReturnOriginalOnMiss
|
|
Next I
|
|
|
|
End Sub
|
|
|
|
|
|
'------------------------------------------------------
|
|
' SelectRange | Selects a range of filled test using
|
|
' from tl to tr, down to the last filled row of tl
|
|
'
|
|
' Params |
|
|
' tl (Top Left): A column letter as a string 'C'
|
|
' startRow: the top row to start at.
|
|
' tr (Top Right): A column letter as a string 'F'
|
|
'
|
|
'Returns -> Selected range from tl to tr down to
|
|
' last filled row of tl
|
|
'-----------------------------------------------------
|
|
Function SelectRange(sheet As String, tl As String, startRow As Integer, tr As String) As Range
|
|
|
|
Dim lastRow As Long
|
|
lastRow = WorkSheets(sheet).Cells(Rows.Count, tl).End(xlUp).Row
|
|
Debug.Print "Select range " & tl & ":" & tr & " | Last Row " & lastRow
|
|
Set SelectRange = WorkSheets(sheet).Range(tl & startRow & ":" & tr & lastRow)
|
|
End Function
|
|
|
|
Function FilterGreatPlains(gpRange As Range, destRange As Range) As Range
|
|
' Filters a source range of data based on a condition, and copies the
|
|
' filtered data to a destination range.
|
|
|
|
' Parameters:
|
|
' gpRange: The range of data to filter.
|
|
' destRange: The destination range to paste the filtered data.
|
|
|
|
Dim I As Long
|
|
Dim goodRowList() As Long
|
|
Dim filteredGp As Range
|
|
|
|
Dim gdn As String
|
|
gdn = "(^(\d+-?)+$)|(ho?ld)"
|
|
Dim cmaRegex As String
|
|
cmaRegex = "cma"
|
|
|
|
' Loop through each row in the source range
|
|
For Each gpRow In gpRange.Rows
|
|
Debug.Print ("")
|
|
Debug.Print ("Doc Type: " + Trim(gpRow.Cells(1, 5).Value))
|
|
' Only take cells in E (Document Type) that are 'Invoice'
|
|
If Not gpRow.Cells(1, 5).Value = "Invoice" Then
|
|
Debug.Print ("Kicked! Not an invoice!")
|
|
GoTo NextRow ' This is not a row we need
|
|
End If
|
|
Debug.Print ("Doc Num: " + Trim(gpRow.Cells(1, 7).Value))
|
|
' If regex matches on the docuemnt number (G) kick don't include
|
|
If Not MatchFound(gdn, Trim(gpRow.Cells(1, 7).Value)) Then
|
|
Debug.Print ("Kicked! Did not match doc # regex!")
|
|
GoTo NextRow
|
|
End If
|
|
Debug.Print ("Purch Num: " + Trim(gpRow.Cells(1, 11).Value))
|
|
' Check Purchase Order Number (K) for CMA
|
|
If MatchFound(cmaRegex, gpRow.Cells(1, 11).Value) Then
|
|
Debug.Print ("Kicked! CMA in purch order #!")
|
|
GoTo NextRow
|
|
End If
|
|
' If none of the kickout conditions were met then
|
|
' record this a good row
|
|
Debug.Print ("Good!")
|
|
ReDim Preserve goodRowList(I)
|
|
goodRowList(I) = gpRow.Row
|
|
I = I + 1
|
|
NextRow:
|
|
Next gpRow
|
|
|
|
' Copy the filtered rows to the destination range
|
|
PasteRows gpRange, goodRowList, destRange
|
|
|
|
' Define a new range object representing the filtered data
|
|
Set filteredGp = destRange.Resize(I, gpRange.Columns.Count)
|
|
|
|
' Return the filtered range object
|
|
Set FilterGreatPlains = filteredGp
|
|
End Function
|
|
Function MatchFound(regexPattern As String, cellValue As String, Optional ignoreCase As Boolean = True) As Boolean
|
|
Dim regex As New RegExp
|
|
regex.Pattern = regexPattern ' Set the regular expression pattern
|
|
regex.ignoreCase = ignoreCase
|
|
If regex.Test(cellValue) Then ' Test the cell value against the regular expression pattern
|
|
MatchFound = True ' If a match is found, return True
|
|
Else
|
|
MatchFound = False ' If no match is found, return False
|
|
End If
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------
|
|
'ExtractMatch Function | Extracts the first match of a regex pattern
|
|
'
|
|
'@param regexPattern | The regex pattern to match
|
|
'@param cellValue | The input string to search for matches
|
|
'@param ignoreCase | Optional boolean indicating if case should be ignored (default True)
|
|
'@param room | ReturnOriginalOnMissing -> Optional boolean indicating if the original cell value should be returned if no matches are found (default False)
|
|
'
|
|
'@return | String value of the first regex match, or #N/A if no matches found and room parameter is False
|
|
'-------------------------------------------------------------------
|
|
Function ExtractMatch(regexPattern As String, cellValue As String, Optional ignoreCase As Boolean = True, Optional room As Boolean = False) As String
|
|
' Create a new RegExp object and set its properties
|
|
Dim regex As New RegExp
|
|
regex.Pattern = regexPattern
|
|
regex.ignoreCase = ignoreCase
|
|
|
|
' Find all matches in the input string
|
|
Dim regexMatches As Object
|
|
Set regexMatches = regex.Execute(inputString)
|
|
|
|
' If there are no matches, return either the input string or Null depending on the value of "room"
|
|
If regexMatchs.Count = 0 Then
|
|
Debug.Print ("No match found! " + regexPattern + " not in " + cellValue)
|
|
If room Then
|
|
Debug.Print ("Returning original value.")
|
|
Set ExtractMatch = cellValue
|
|
Else
|
|
Set ExtractMatch = CVErr(xlErrNA) ' Return #N/A error
|
|
End If
|
|
Else
|
|
' If there is at least one match, iterate through all the matches and return the value of the first match found
|
|
Dim match As Object
|
|
For Each match In regexMatches:
|
|
Debug.Print ("Match : " + match.Value)
|
|
Set ExtractMatch = match.Value
|
|
Exit Function ' exit the loop after the first match is found
|
|
Next match
|
|
End If
|
|
End Function |