Guest User

Untitled

a guest
Jan 23rd, 2018
103
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.80 KB | None | 0 0
  1. Sub InvoicesUpdate()
  2. '
  3. 'Application Settings
  4. Application.ScreenUpdating = False
  5. Application.DisplayAlerts = False
  6. Application.Calculation = xlCalculationManual
  7.  
  8. 'Instantiate control variables
  9. Dim allRows As Long, currentOffset As Long, invoiceActive As Boolean, mAllRows As Long
  10. Dim iAllRows As Long, unusedRow As Long, row As Long, mWSExists As Boolean, newmAllRows As Long
  11.  
  12. 'Instantiate invoice variables
  13. Dim accountNum As String, custName As String, vinNum As String, caseNum As String, statusField As String
  14. Dim invDate As String, makeField As String, feeDesc As String, amountField As String, invNum As String
  15.  
  16. 'Instantiate Workbook variables
  17. Dim mWB As Workbook 'master
  18. Dim iWB As Workbook 'import
  19.  
  20. 'Instantiate Worksheet variables
  21. Dim mWS As Worksheet
  22. Dim iWS As Worksheet
  23.  
  24. 'Instantiate Range variables
  25. Dim iData As Range
  26.  
  27. 'Initialize variables
  28. invoiceActive = False
  29. row = 0
  30.  
  31. 'Open import workbook
  32. Workbooks.Open ("path:excel_invoices.csv")
  33. Set iWB = ActiveWorkbook
  34. Set iWS = iWB.Sheets("excel_invoices.csv")
  35. iWS.Activate
  36. Range("A1").Select
  37. iAllRows = iWS.UsedRange.Rows.Count 'Count rows of import data
  38.  
  39. 'Instantiate array, include extra column for client name
  40. Dim invoices()
  41. ReDim invoices(10, 0)
  42.  
  43. 'Loop through rows.
  44. Do
  45.  
  46. 'Check for the start of a client and store client name
  47. If ActiveCell.Value = "Account Number" Then
  48.  
  49. clientName = ActiveCell.Offset(-1, 6).Value
  50.  
  51. End If
  52.  
  53. If ActiveCell.Offset(0, 3).Value <> Empty And ActiveCell.Value <> "Account Number" And ActiveCell.Offset(2, 0) = Empty Then
  54.  
  55. invoiceActive = True
  56.  
  57. 'Populate account information.
  58. accountNum = ActiveCell.Offset(0, 0).Value
  59. vinNum = ActiveCell.Offset(0, 1).Value
  60. 'leave out customer name for FDCPA reasons
  61. caseNum = ActiveCell.Offset(0, 3).Value
  62. statusField = ActiveCell.Offset(0, 4).Value
  63. invDate = ActiveCell.Offset(0, 5).Value
  64. makeField = ActiveCell.Offset(0, 6).Value
  65.  
  66. End If
  67.  
  68. If invoiceActive = True And ActiveCell.Value = Empty And ActiveCell.Offset(0, 6).Value = Empty And ActiveCell.Offset(0, 9).Value = Empty Then
  69.  
  70. 'Make sure something other than $0 was invoiced
  71. If ActiveCell.Offset(0, 8).Value <> 0 Then
  72.  
  73. 'Populate individual item values.
  74. feeDesc = ActiveCell.Offset(0, 7).Value
  75. amountField = ActiveCell.Offset(0, 8).Value
  76. invNum = ActiveCell.Offset(0, 10).Value
  77.  
  78. 'Transfer data to array
  79. invoices(0, row) = "=TODAY()"
  80. invoices(1, row) = accountNum
  81. invoices(2, row) = clientName
  82. invoices(3, row) = vinNum
  83. invoices(4, row) = caseNum
  84. invoices(5, row) = statusField
  85. invoices(6, row) = invDate
  86. invoices(7, row) = makeField
  87. invoices(8, row) = feeDesc
  88. invoices(9, row) = amountField
  89. invoices(10, row) = invNum
  90.  
  91. 'Increment row counter for array
  92. row = row + 1
  93.  
  94. 'Resize array for next entry
  95. ReDim Preserve invoices(10,row)
  96.  
  97. End If
  98.  
  99. End If
  100.  
  101. 'Find the end of an invoice
  102. If invoiceActive = True And ActiveCell.Offset(0, 9) <> Empty Then
  103.  
  104. 'Set the flag to outside of an invoice
  105. invoiceActive = False
  106.  
  107. End If
  108.  
  109. 'Increment active cell to next cell down
  110. ActiveCell.Offset(1, 0).Activate
  111.  
  112. 'Define end of the loop at the last used row
  113. Loop Until ActiveCell.row = iAllRows
  114.  
  115. 'Close import data file
  116. iWB.Close
  117.  
  118. Dim invoices()
  119. Redim invoices(10,0)
  120.  
  121. ReDim Preserve MyArray(10,20) '<-- Returns Error
  122.  
  123. MyArray = ReDimPreserve(MyArray,10,20)
  124.  
  125. 'redim preserve both dimensions for a multidimension array *ONLY
  126. Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound)
  127. ReDimPreserve = False
  128. 'check if its in array first
  129. If IsArray(aArrayToPreserve) Then
  130. 'create new array
  131. ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound)
  132. 'get old lBound/uBound
  133. nOldFirstUBound = uBound(aArrayToPreserve,1)
  134. nOldLastUBound = uBound(aArrayToPreserve,2)
  135. 'loop through first
  136. For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound
  137. For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound
  138. 'if its in range, then append to new array the same way
  139. If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
  140. aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast)
  141. End If
  142. Next
  143. Next
  144. 'return the array redimmed
  145. If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
  146. End If
  147. End Function
  148.  
  149. Option explicit
  150. 'redim preserve both dimensions for a multidimension array *ONLY
  151. Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant
  152. Dim nFirst As Long
  153. Dim nLast As Long
  154. Dim nOldFirstUBound As Long
  155. Dim nOldLastUBound As Long
  156.  
  157. ReDimPreserve = False
  158. 'check if its in array first
  159. If IsArray(aArrayToPreserve) Then
  160. 'create new array
  161. ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
  162. 'get old lBound/uBound
  163. nOldFirstUBound = UBound(aArrayToPreserve, 1)
  164. nOldLastUBound = UBound(aArrayToPreserve, 2)
  165. 'loop through first
  166. For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
  167. For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound
  168. 'if its in range, then append to new array the same way
  169. If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
  170. aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast)
  171. End If
  172. Next
  173. Next
  174. 'return the array redimmed
  175. If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
  176. End If
  177. End Function
Add Comment
Please, Sign In to add comment