Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub InvoicesUpdate()
- '
- 'Application Settings
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Application.Calculation = xlCalculationManual
- 'Instantiate control variables
- Dim allRows As Long, currentOffset As Long, invoiceActive As Boolean, mAllRows As Long
- Dim iAllRows As Long, unusedRow As Long, row As Long, mWSExists As Boolean, newmAllRows As Long
- 'Instantiate invoice variables
- Dim accountNum As String, custName As String, vinNum As String, caseNum As String, statusField As String
- Dim invDate As String, makeField As String, feeDesc As String, amountField As String, invNum As String
- 'Instantiate Workbook variables
- Dim mWB As Workbook 'master
- Dim iWB As Workbook 'import
- 'Instantiate Worksheet variables
- Dim mWS As Worksheet
- Dim iWS As Worksheet
- 'Instantiate Range variables
- Dim iData As Range
- 'Initialize variables
- invoiceActive = False
- row = 0
- 'Open import workbook
- Workbooks.Open ("path:excel_invoices.csv")
- Set iWB = ActiveWorkbook
- Set iWS = iWB.Sheets("excel_invoices.csv")
- iWS.Activate
- Range("A1").Select
- iAllRows = iWS.UsedRange.Rows.Count 'Count rows of import data
- 'Instantiate array, include extra column for client name
- Dim invoices()
- ReDim invoices(10, 0)
- 'Loop through rows.
- Do
- 'Check for the start of a client and store client name
- If ActiveCell.Value = "Account Number" Then
- clientName = ActiveCell.Offset(-1, 6).Value
- End If
- If ActiveCell.Offset(0, 3).Value <> Empty And ActiveCell.Value <> "Account Number" And ActiveCell.Offset(2, 0) = Empty Then
- invoiceActive = True
- 'Populate account information.
- accountNum = ActiveCell.Offset(0, 0).Value
- vinNum = ActiveCell.Offset(0, 1).Value
- 'leave out customer name for FDCPA reasons
- caseNum = ActiveCell.Offset(0, 3).Value
- statusField = ActiveCell.Offset(0, 4).Value
- invDate = ActiveCell.Offset(0, 5).Value
- makeField = ActiveCell.Offset(0, 6).Value
- End If
- If invoiceActive = True And ActiveCell.Value = Empty And ActiveCell.Offset(0, 6).Value = Empty And ActiveCell.Offset(0, 9).Value = Empty Then
- 'Make sure something other than $0 was invoiced
- If ActiveCell.Offset(0, 8).Value <> 0 Then
- 'Populate individual item values.
- feeDesc = ActiveCell.Offset(0, 7).Value
- amountField = ActiveCell.Offset(0, 8).Value
- invNum = ActiveCell.Offset(0, 10).Value
- 'Transfer data to array
- invoices(0, row) = "=TODAY()"
- invoices(1, row) = accountNum
- invoices(2, row) = clientName
- invoices(3, row) = vinNum
- invoices(4, row) = caseNum
- invoices(5, row) = statusField
- invoices(6, row) = invDate
- invoices(7, row) = makeField
- invoices(8, row) = feeDesc
- invoices(9, row) = amountField
- invoices(10, row) = invNum
- 'Increment row counter for array
- row = row + 1
- 'Resize array for next entry
- ReDim Preserve invoices(10,row)
- End If
- End If
- 'Find the end of an invoice
- If invoiceActive = True And ActiveCell.Offset(0, 9) <> Empty Then
- 'Set the flag to outside of an invoice
- invoiceActive = False
- End If
- 'Increment active cell to next cell down
- ActiveCell.Offset(1, 0).Activate
- 'Define end of the loop at the last used row
- Loop Until ActiveCell.row = iAllRows
- 'Close import data file
- iWB.Close
- Dim invoices()
- Redim invoices(10,0)
- ReDim Preserve MyArray(10,20) '<-- Returns Error
- MyArray = ReDimPreserve(MyArray,10,20)
- 'redim preserve both dimensions for a multidimension array *ONLY
- Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound)
- ReDimPreserve = False
- 'check if its in array first
- If IsArray(aArrayToPreserve) Then
- 'create new array
- ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound)
- 'get old lBound/uBound
- nOldFirstUBound = uBound(aArrayToPreserve,1)
- nOldLastUBound = uBound(aArrayToPreserve,2)
- 'loop through first
- For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound
- For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound
- 'if its in range, then append to new array the same way
- If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
- aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast)
- End If
- Next
- Next
- 'return the array redimmed
- If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
- End If
- End Function
- Option explicit
- 'redim preserve both dimensions for a multidimension array *ONLY
- Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant
- Dim nFirst As Long
- Dim nLast As Long
- Dim nOldFirstUBound As Long
- Dim nOldLastUBound As Long
- ReDimPreserve = False
- 'check if its in array first
- If IsArray(aArrayToPreserve) Then
- 'create new array
- ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
- 'get old lBound/uBound
- nOldFirstUBound = UBound(aArrayToPreserve, 1)
- nOldLastUBound = UBound(aArrayToPreserve, 2)
- 'loop through first
- For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
- For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound
- 'if its in range, then append to new array the same way
- If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
- aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast)
- End If
- Next
- Next
- 'return the array redimmed
- If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
- End If
- End Function
Add Comment
Please, Sign In to add comment