Copy a block of data into existing cells, adding a new line

Question

Wondering about efficiency here - I have a bit of code that does what I want; but it is terribly slow. I structured the code in a way that made sense to me logically, but I'm wondering if someone else could take a look at the code and find a shortcut or two that might make it faster. I'm guessing that I am referencing the Worksheet too often in one of the loops, but haven't been able to find a good way to restructure to improve performance.

What is it doing: Each row contains a record with a single ID, Name, etc. on the row. There are also multiple response items that work together and those are basically a table or array that is 9 columns wide and however many rows tall based on the current Alternate Logic in the table. So if a single record has 2 types of alternate logic at the beginning, the array would be (1 to 9, 1 to 2) or I guess (0 to 8, 0 to 1). I'm basically looking for a specific row in the existing table and then adding new lines. So when I'm done, I expect the array to be taller by at least one more row.

Why are we doing it? Each record is a charge code for a hospital, and the charge codes have a default Revenue Code, but depending on the cost center or payer - an alternate Revenue Code may be needed. I need to copy all lines where a specific cost center is used to identify alternate Revenue Codes and then copy that existing data and add my new line(s) where the only change on the new lines from the source line is the cost center ID itself.

Option Explicit
Sub addAlternateRevCodeLogic()
Dim WS As Worksheet
Dim rng As Range
Dim lastColumn As Long
Dim row As Long
Dim i As Long
Dim ReferenceStyle As XlReferenceStyle
'Arrays of the different Alt Rev Code fields on an EAP
Dim AltID() As String
Dim EffFrom() As String
Dim EffTo() As String
Dim ProvType() As String
Dim BCC() As String
Dim DEP() As String
Dim EAF() As String
Dim Class() As String
Dim RevCode() As String
'Alt Rev Code data from the matching rows
Dim rowAltID As String
Dim rowEffFrom As String
Dim rowEffTo As String
Dim rowProvType As String
Dim rowBCC As String
Dim rowDEP As String
Dim rowEAF As String
Dim rowClass As String
Dim rowRevCode As String
'New and old cost centers
Dim newBCC() As String
Dim oldBCC As String
Dim CostCenter As Variant
Dim userInput As String
'Columns for Rev Code Ranges
Dim AltIDcol As Long 'I EAP 2431
Dim EffFromcol As Long 'I EAP 2434
Dim EffTocol As Long 'I EAP 2435
Dim ProvTypecol As Long 'I EAP 2439
Dim BCCcol As Long 'I EAP 2438
Dim DEPcol As Long 'I EAP 2437
Dim EAFcol As Long 'I EAP 2436
Dim Classcol As Long 'I EAP 2432
Dim RevCodecol As Long 'I EAP 2433
Application.ScreenUpdating = False
ReferenceStyle = Application.ReferenceStyle
If ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1 'There are certain assumptions in the ranges that don't play nicely with R1C1
'Data is Chr(10) delimited
'Define the range of the EAP Export
Set WS = Worksheets("export")
lastColumn = eap.Cells.Find("*", After:=eap.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set rng = WS.Range("A1", WS.Columns(1).Find(what:="#LAST_ROW", LookIn:=xlComments, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, lastColumn))
'Define all of the column IDs
AltIDcol = FindCol(2431, eap, True, 1, 1, 1, lastColumn)
EffFromcol = FindCol(2434, eap, True, 1, 1, 1, lastColumn)
EffTocol = FindCol(2435, eap, True, 1, 1, 1, lastColumn)
ProvTypecol = FindCol(2439, eap, True, 1, 1, 1, lastColumn)
BCCcol = FindCol(2438, eap, True, 1, 1, 1, lastColumn)
DEPcol = FindCol(2437, eap, True, 1, 1, 1, lastColumn)
EAFcol = FindCol(2436, eap, True, 1, 1, 1, lastColumn)
Classcol = FindCol(2432, eap, True, 1, 1, 1, lastColumn)
RevCodecol = FindCol(2433, eap, True, 1, 1, 1, lastColumn)
oldBCC = InputBox("What cost center do you want to copy?" & vbNewLine & "Select only one, and don't make typos")
If oldBCC = "" Then MsgBox "Must choose a cost center!", vbOKOnly + vbCritical: Exit Sub
Do
 userInput = InputBox("What are the new cost centers that need added?" & vbNewLine & "You can enter multiple, just keep adding them and then leave the box blank after the last one" & vbNewLine & "Don't make typos", "New Cost Centers")
 Select Case True
 Case CostCenter = "" And userInput <> "" 'Handle the 1st cost center
 CostCenter = userInput
 Case CostCenter <> "" And userInput <> "" 'Handle each new input
 CostCenter = CostCenter & "," & userInput
 Case CostCenter = "" And userInput = "" 'Handle no input
 MsgBox "Must choose at least one new cost center!", vbOKOnly + vbCritical: Exit Sub
 End Select
Loop While userInput <> ""
'oldBCC = "10005320" 'Test Emergency Cost Center
'oldBCC = "10004320" 'Test Pediatrics Cost Center
'CostCenter = "70005320" 'Test New Emergency Cost Center
'CostCenter = "70004110,70004130,70004140,70004200,70004420,70004510,70004400,70004430,70004500" 'Test New Pediatrics Cost Centers
newBCC() = Split(CostCenter, ",")
With rng
 For row = LBound(.Value2) To UBound(.Value2) 'Loop through each row from the export
 If Not IsEmpty(.Value2(row, RevCodecol)) Then 'Find any row that contains an alternate revenue code
 If InStr(1, .Value2(row, BCCcol), oldBCC) Then 'Check if the TRH Emergency Cost Center is using one of the alternate revenue codes
 'Build an array for each Alt Rev Code data item
 RevCode() = Split(.Value2(row, RevCodecol), Chr(10))
 AltID() = Split(.Value2(row, AltIDcol), Chr(10))
 EffFrom() = Split(.Value2(row, EffFromcol), Chr(10))
 EffTo() = Split(.Value2(row, EffTocol), Chr(10))
 ProvType() = Split(.Value2(row, ProvTypecol), Chr(10))
 BCC() = Split(.Value2(row, BCCcol), Chr(10))
 DEP() = Split(.Value2(row, DEPcol), Chr(10))
 EAF() = Split(.Value2(row, EAFcol), Chr(10))
 Class() = Split(.Value2(row, Classcol), Chr(10))
 For i = LBound(RevCode()) To UBound(RevCode())
 If InStr(1, BCC(i), oldBCC) Then 'Set row data for a line with the cost center to copy
 rowAltID = AltID(i)
 rowEffFrom = EffFrom(i)
 rowEffTo = EffTo(i)
 rowProvType = ProvType(i)
 rowBCC = BCC(i)
 rowDEP = DEP(i)
 rowEAF = EAF(i)
 rowClass = Class(i)
 rowRevCode = RevCode(i)
 'Copy the existing value and add the new line(s)
 For Each CostCenter In newBCC 'Copy existing lines and add a new entry for each new cost center
 .Cells(row, AltIDcol).Value = .Value2(row, AltIDcol) & Chr(10) & rowAltID ' & Chr(10)
 .Cells(row, EffFromcol).Value = .Value2(row, EffFromcol) & Chr(10) & rowEffFrom ' & Chr(10)
 .Cells(row, EffTocol).Value = .Value2(row, EffTocol) & Chr(10) & rowEffTo ' & Chr(10)
 .Cells(row, ProvTypecol).Value = .Value2(row, ProvTypecol) & Chr(10) & rowProvType ' & Chr(10)
 .Cells(row, BCCcol).Value = .Value2(row, BCCcol) & Chr(10) & CostCenter ' & Chr(10)
 .Cells(row, DEPcol).Value = .Value2(row, DEPcol) & Chr(10) & rowDEP ' & Chr(10)
 .Cells(row, EAFcol).Value = .Value2(row, EAFcol) & Chr(10) & rowEAF ' & Chr(10)
 .Cells(row, Classcol).Value = .Value2(row, Classcol) & Chr(10) & rowClass ' & Chr(10)
 .Cells(row, RevCodecol).Value = .Value2(row, RevCodecol) & Chr(10) & rowRevCode ' & Chr(10)
 Next CostCenter
 End If
 Next i
 End If
 End If
 Next row
End With
If ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlR1C1
Application.ScreenUpdating = True
MsgBox "Rev Codes updated. Test the import.", vbInformation + vbOKOnly
End Sub
```

• pacmaninbw: Welcome to the Code Review Community. We need some background details. How much data is being processed? Please quantify terribly slow.
• Freeflow: You need to explain better what your code is trying to do in a fair bit of detail rather than just dumping code here and expecting us to fathom its working. You should also take the time to update your code with more meaningful and user friendly variable names. At present, your code is fairly impenetrable.
• immobile2: 1. Terribly slow is several minutes for about 900 rows in a spreadsheet. 2. Wasn't a fan of pasting the code in initially, but let's say I get rid of most of the code block and just provide an example - would that suffice? I found that saying in words what I was trying to do was difficult and there was a not that "The more code you share, the better" so I went big
• Freeflow: If you can't explain what you want to do simply and succinctly there's little chance of being able to write decent code as typically the inability to explain is linked to a lack of understanding about what is required and how to translate the requirement into code. So please, for now, just focus on clearly and succinctly explaining what it is you are trying to achieve.
• Greedo: Hi, don't worry lots of code is good, we need all the info we can get! Indeed you haven't included the FindCol function and I'm guessing eap is your worksheet's code name because I can't see it defined anywhere, but do confirm? In terms of extra context, it would be useful to include a sample of the data to see if its structure yields some insight. As it stands this is doing much more than just copying data from one place to another adding newlines so if you could explain that in more detail, the why of your code, it would help people understand it to give useful feedback.

Answer 1

You are right in what you are thinking: reading from and writing to the worksheet is notoriously slow.

Without doing anything else, you will probably get a significant performance boost just from turning Calculation off at the same place in your code where you are turning ScreenUpdating on and off:

 'Variable Declarations
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 'The rest of your code here
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

It would be so much easier if each existing cost center was on its own row instead of having many in each! We'll just assume that you don't have any control over this and commiserate with you :)

Each time your code finds the user-input old cost code in the BCCcol column, it copies the old cost code details in that row. Then it appends the cells in that row with the new cost code(s) and those copied details.

If you were to use one of your commented test examples:

'oldBCC = "10004320" 'Test Pediatrics Cost Center
'CostCenter = "70004110,70004130,70004140,70004200,70004420,70004510,70004400,70004430,70004500" 'Test New Pediatrics Cost Centers

There are nine new cost centers in CostCenter, so each time your code finds oldBCC in a row, it appends the cells in that row nine times. There are nine cells to append each time, so that's 81 separate writes to the worksheet for each row where there is a match. This will be slow.

There must be a better way to go than splitting each relevant cell into its own little array, but I'm going to leave that for someone more experienced that me.

I'm not sure your row string variables are adding much benefit either (e.g. rowAltID). I think the code for appending the new cost centers would be just as easy to read without them (but I also don't think they're slowing your code down much).

If you were to write each cell's new value to a string variable and then only update the cells in the row with the new string variables once at the end you should see another large improvement. I'll use the AltID column as an example:

Dim newAltID As String
 '...string declarations for the other cells go here...
 '...then other initial code as before...
For i = LBound(RevCode()) To UBound(RevCode())
 If InStr(1, BCC(i), oldBCC) Then 'Set row data for a line with the cost center to copy
 
 'Put the existing cell values into their string variables
 newAltID = .Cells(row, AltIDcol).Value
 '...continue for the other cell's strings
 
 For Each CostCenter In newBCC 'Add a new entry for each new cost center
 newAltID = newAltID & Chr(10) & AltID(i)
 'or newAltID = newAltID & Chr(10) & rowAltID 
 '...continue for the other cell's strings
 Next CostCenter
 'Then write the appended strings back to the worksheet once at the end
 .Cells(row, AltIDcol).Value = newAltID
 '...continue for the other cell's strings
 End If
Next i

Edit: removed personal opinion where it was unnecessary.

• immobile2: Thanks for the insight, I don't have a spreadsheet handy at the moment, but I'll update my question with an example to help visualize. I do technically have the option to split the data to different rows rather than Chr(10) delimited, but it adds a bit of extra complexity I wanted to avoid, especially the fact that insert row is going to be slow. This is really helpful though and I realize now that the main drag is the writing part, so I'm thinking about saving the source data into a variant array variable, making all updates in a new array, and then writing the entire array at once-Copy/paste

Answer 2

Ok i'll try have a crack it with the info you've given... the code isnt going to be elegant but i've tried my best. I cant check if the code works since i dont have the full code / sheet you've provided.

If you are not interested in how it all works go to the bottom of the post and you'll see the full code combined together. just copy and paste and see if it works!

As a few of the answers mentioned commincating with a sheet can be extremely slow (especially if you've got calculations on at the same time).

At the start of your code i would recommond:

Application.ScreenUpdating = True '**** see below
Application.Calculation = xlCalculationManual
' if your code errors and produces a pop up this can cause your excel to crash i prefer to keep this until you are well versed with how VBA works
' if your code is fully using arrays then screen updating usually provides a negligible benefit
' if you are unfamiliar with using arrays i suggest finalising your code and then turning it off

At the end of your code i would recommond:

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic

Method:

1. Loop through the data (as an array this time and not a range)
2. Find out the size of the new insert
3. Loop through the data again this time into the array
4. paste the data at the bottom of the sheet

Looping through an array twice should still be 100x (dont quote me) faster.

I've made two assumptions:

1. The section of code below gets the data from the sheet called "export" with column one being the master column (the one if you go to the end it shows the last row)
2. You paste the data back into the 'Export' sheet at the bottom of the page to the next line.

for point 1 - i've replaced the following code:

set WS = Worksheets("export")
lastColumn = eap.Cells.Find("*", After:=eap.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set rng = WS.Range("A1", WS.Columns(1).Find(what:="#LAST_ROW", LookIn:=xlComments, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, lastColumn))

---

with:

Dim arr() As Variant
arr() = GetArr("export")

---

for point 2 - i've added the following code at the end:

PasteArr "export", arrNew, 1, False, True

---

I've added two functions: one to get the array from the sheet, one to paste the array to the sheet

---

'------- ---------------------- ---------
'------- Get Data into an Array ---------
'------- ---------------------- ---------
Function GetArr(SheetName As String, Optional ColumnForSize As Long = 1, Optional Rowstart As Long = 1)
Dim ws As Worksheet
Dim vArray() As Variant
On Error GoTo ErrH
 Set ws = ThisWorkbook.Sheets(SheetName): On Error GoTo 0
 
With ws
 If .FilterMode = True Then .ShowAllData
 lRow = .Cells(.Rows.Count, ColumnForSize).End(xlUp).row
 lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 If lRow > 1 Or lCol > 1 Then
 vArray() = .Cells(Rowstart, 1).Resize(lRow - Rowstart + 1, lCol).Value2
 GetArr = vArray()
 End If
End With
EndFunction:
Exit Function
ErrH:
Debug.Print "Worksheet name '" & SheetName & "' not found."
Resume EndFunction
End Function
'------- -------------------- ---------
'------- Paste Array to Sheet ---------
'------- -------------------- ---------
Function PasteArr(SheetName As String, vArray() As Variant, Optional ColumnForSize As Long = 1, Optional bClearContents As Boolean = True, Optional bLastRow As Boolean, Optional bOmitFirstRow As Boolean)
Dim ws As Worksheet
On Error GoTo ErrH
 Set ws = ThisWorkbook.Sheets(SheetName): On Error GoTo 0
x = 0
With ws
 If .FilterMode = True Then .ShowAllData
 If bClearContents Then
 lRow = .Cells(.Rows.Count, ColumnForSize).End(xlUp).row
 lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 If lRow > 1 Then .Cells(1, 1).Resize(lRow, lCol).ClearContents
 End If
 If bOmitFirstRow Then
 For i = LBound(vArray, 2) To UBound(vArray, 2)
 vArray(LBound(vArray), i) = vArray(UBound(vArray), i)
 vArray(UBound(vArray), i) = ""
 Next
 x = 1
 End If
 If Not (Not vArray()) Then
 If bLastRow Then
 lRow = .Cells(.Rows.Count, ColumnForSize).End(xlUp).row + 1
 .Cells(lRow, 1).Resize(UBound(vArray) - x, UBound(vArray, 2)) = vArray()
 Else
 .Cells(1, 1).Resize(UBound(vArray) - x, UBound(vArray, 2)) = vArray()
 End If
 End If
End With
EndFunction:
Exit Function
ErrH:
Debug.Print "Worksheet name '" & SheetName & "' not found."
Resume EndFunction
End Function

---

Packaging all the above comments together this is what it looks like:

---

Option Base 1
Sub addAlternateRevCodeLogic()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Dim ws As Worksheet
Dim rng As Range
Dim lastColumn As Long
Dim row As Long
Dim i As Long
Dim ReferenceStyle As XlReferenceStyle
'Arrays of the different Alt Rev Code fields on an EAP
Dim AltID() As String
Dim EffFrom() As String
Dim EffTo() As String
Dim ProvType() As String
Dim BCC() As String
Dim DEP() As String
Dim EAF() As String
Dim Class() As String
Dim RevCode() As String
'Alt Rev Code data from the matching rows
Dim rowAltID As String
Dim rowEffFrom As String
Dim rowEffTo As String
Dim rowProvType As String
Dim rowBCC As String
Dim rowDEP As String
Dim rowEAF As String
Dim rowClass As String
Dim rowRevCode As String
'New and old cost centers
Dim newBCC() As String
Dim oldBCC As String
Dim CostCenter As Variant
Dim userInput As String
'Columns for Rev Code Ranges
Dim AltIDcol As Long 'I EAP 2431
Dim EffFromcol As Long 'I EAP 2434
Dim EffTocol As Long 'I EAP 2435
Dim ProvTypecol As Long 'I EAP 2439
Dim BCCcol As Long 'I EAP 2438
Dim DEPcol As Long 'I EAP 2437
Dim EAFcol As Long 'I EAP 2436
Dim Classcol As Long 'I EAP 2432
Dim RevCodecol As Long 'I EAP 2433
'Application.ScreenUpdating = False
ReferenceStyle = Application.ReferenceStyle
If ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1 'There are certain assumptions in the ranges that don't play nicely with R1C1
'Data is Chr(10) delimited
'Define the range of the EAP Export
Dim arr() As Variant
Dim arrNew() As Variant
arr() = GetArr("export")
'Define all of the column IDs
AltIDcol = FindCol(2431, eap, True, 1, 1, 1, lastColumn)
EffFromcol = FindCol(2434, eap, True, 1, 1, 1, lastColumn)
EffTocol = FindCol(2435, eap, True, 1, 1, 1, lastColumn)
ProvTypecol = FindCol(2439, eap, True, 1, 1, 1, lastColumn)
BCCcol = FindCol(2438, eap, True, 1, 1, 1, lastColumn)
DEPcol = FindCol(2437, eap, True, 1, 1, 1, lastColumn)
EAFcol = FindCol(2436, eap, True, 1, 1, 1, lastColumn)
Classcol = FindCol(2432, eap, True, 1, 1, 1, lastColumn)
RevCodecol = FindCol(2433, eap, True, 1, 1, 1, lastColumn)
oldBCC = InputBox("What cost center do you want to copy?" & vbNewLine & "Select only one, and don't make typos")
If oldBCC = "" Then MsgBox "Must choose a cost center!", vbOKOnly + vbCritical: Exit Sub
Do
 userInput = InputBox("What are the new cost centers that need added?" & vbNewLine & "You can enter multiple, just keep adding them and then leave the box blank after the last one" & vbNewLine & "Don't make typos", "New Cost Centers")
 Select Case True
 Case CostCenter = "" And userInput <> "" 'Handle the 1st cost center
 CostCenter = userInput
 Case CostCenter <> "" And userInput <> "" 'Handle each new input
 CostCenter = CostCenter & "," & userInput
 Case CostCenter = "" And userInput = "" 'Handle no input
 MsgBox "Must choose at least one new cost center!", vbOKOnly + vbCritical: Exit Sub
 End Select
Loop While userInput <> ""
'oldBCC = "10005320" 'Test Emergency Cost Center
'oldBCC = "10004320" 'Test Pediatrics Cost Center
'CostCenter = "70005320" 'Test New Emergency Cost Center
'CostCenter = "70004110,70004130,70004140,70004200,70004420,70004510,70004400,70004430,70004500" 'Test New Pediatrics Cost Centers
newBCC() = Split(CostCenter, ",")
xCounter = 0
For row = LBound(arr) To UBound(arr) 'Loop through each row from the export
 If Not IsEmpty(arr(row, RevCodecol)) Then 'Find any row that contains an alternate revenue code
 If InStr(1, arr(row, BCCcol), oldBCC) Then 'Check if the TRH Emergency Cost Center is using one of the alternate revenue codes
 'Build an array for each Alt Rev Code data item
 RevCode() = Split(arr(row, RevCodecol), Chr(10))
 AltID() = Split(arr(row, AltIDcol), Chr(10))
 EffFrom() = Split(arr(row, EffFromcol), Chr(10))
 EffTo() = Split(arr(row, EffTocol), Chr(10))
 ProvType() = Split(arr(row, ProvTypecol), Chr(10))
 BCC() = Split(arr(row, BCCcol), Chr(10))
 DEP() = Split(arr(row, DEPcol), Chr(10))
 EAF() = Split(arr(row, EAFcol), Chr(10))
 Class() = Split(arr(row, Classcol), Chr(10))
 For i = LBound(RevCode()) To UBound(RevCode())
 If InStr(1, BCC(i), oldBCC) Then 'Set row data for a line with the cost center to copy
 rowAltID = AltID(i)
 rowEffFrom = EffFrom(i)
 rowEffTo = EffTo(i)
 rowProvType = ProvType(i)
 rowBCC = BCC(i)
 rowDEP = DEP(i)
 rowEAF = EAF(i)
 rowClass = Class(i)
 rowRevCode = RevCode(i)
 'Copy the existing value and add the new line(s)
 For Each CostCenter In newBCC 'Copy existing lines and add a new entry for each new cost center
 xCounter = xCounter = 1
 Next CostCenter
 End If
 Next i
 End If
 End If
Next
If xCounter > 0 Then
 ReDim arrNew(xCounter, UBound(arr, 2))
 xCounter = 0
 For row = LBound(arr) To UBound(arr) 'Loop through each row from the export
 If Not IsEmpty(arr(row, RevCodecol)) Then 'Find any row that contains an alternate revenue code
 If InStr(1, arr(row, BCCcol), oldBCC) Then 'Check if the TRH Emergency Cost Center is using one of the alternate revenue codes
 'Build an array for each Alt Rev Code data item
 RevCode() = Split(arr(row, RevCodecol), Chr(10))
 AltID() = Split(arr(row, AltIDcol), Chr(10))
 EffFrom() = Split(arr(row, EffFromcol), Chr(10))
 EffTo() = Split(arr(row, EffTocol), Chr(10))
 ProvType() = Split(arr(row, ProvTypecol), Chr(10))
 BCC() = Split(arr(row, BCCcol), Chr(10))
 DEP() = Split(arr(row, DEPcol), Chr(10))
 EAF() = Split(arr(row, EAFcol), Chr(10))
 Class() = Split(arr(row, Classcol), Chr(10))
 For i = LBound(RevCode()) To UBound(RevCode())
 If InStr(1, BCC(i), oldBCC) Then 'Set row data for a line with the cost center to copy
 rowAltID = AltID(i)
 rowEffFrom = EffFrom(i)
 rowEffTo = EffTo(i)
 rowProvType = ProvType(i)
 rowBCC = BCC(i)
 rowDEP = DEP(i)
 rowEAF = EAF(i)
 rowClass = Class(i)
 rowRevCode = RevCode(i)
 'Copy the existing value and add the new line(s)
 For Each CostCenter In newBCC 'Copy existing lines and add a new entry for each new cost center
 xCounter = xCounter = 1
 arrNew(xCounter, AltIDcol).Value = arr(row, AltIDcol) & Chr(10) & rowAltID ' & Chr(10)
 arrNew(xCounter, EffFromcol).Value = arr(row, EffFromcol) & Chr(10) & rowEffFrom ' & Chr(10)
 arrNew(xCounter, EffTocol).Value = arr(row, EffTocol) & Chr(10) & rowEffTo ' & Chr(10)
 arrNew(xCounter, ProvTypecol).Value = arr(row, ProvTypecol) & Chr(10) & rowProvType ' & Chr(10)
 arrNew(xCounter, BCCcol).Value = arr(row, BCCcol) & Chr(10) & CostCenter ' & Chr(10)
 arrNew(xCounter, DEPcol).Value = arr(row, DEPcol) & Chr(10) & rowDEP ' & Chr(10)
 arrNew(xCounter, EAFcol).Value = arr(row, EAFcol) & Chr(10) & rowEAF ' & Chr(10)
 arrNew(xCounter, Classcol).Value = arr(row, Classcol) & Chr(10) & rowClass ' & Chr(10)
 arrNew(xCounter, RevCodecol).Value = arr(row, RevCodecol) & Chr(10) & rowRevCode ' & Chr(10)
 Next CostCenter
 End If
 Next i
 End If
 End If
 Next
End If
PasteArr "export", arrNew, 1, False, True
Application.Calculation = xlCalculationAutomatic
If ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlR1C1
Application.ScreenUpdating = True
MsgBox "Rev Codes updated. Test the import.", vbInformation + vbOKOnly
End Sub
'------- ---------------------- ---------
'------- Get Data into an Array ---------
'------- ---------------------- ---------
Function GetArr(SheetName As String, Optional ColumnForSize As Long = 1, Optional Rowstart As Long = 1)
Dim ws As Worksheet
Dim vArray() As Variant
On Error GoTo ErrH
 Set ws = ThisWorkbook.Sheets(SheetName): On Error GoTo 0
 
With ws
 If .FilterMode = True Then .ShowAllData
 lRow = .Cells(.Rows.Count, ColumnForSize).End(xlUp).row
 lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 If lRow > 1 Or lCol > 1 Then
 vArray() = .Cells(Rowstart, 1).Resize(lRow - Rowstart + 1, lCol).Value2
 GetArr = vArray()
 End If
End With
EndFunction:
Exit Function
ErrH:
Debug.Print "Worksheet name '" & SheetName & "' not found."
Resume EndFunction
End Function
'------- -------------------- ---------
'------- Paste Array to Sheet ---------
'------- -------------------- ---------
Function PasteArr(SheetName As String, vArray() As Variant, Optional ColumnForSize As Long = 1, Optional bClearContents As Boolean = True, Optional bLastRow As Boolean, Optional bOmitFirstRow As Boolean)
Dim ws As Worksheet
On Error GoTo ErrH
 Set ws = ThisWorkbook.Sheets(SheetName): On Error GoTo 0
x = 0
With ws
 If .FilterMode = True Then .ShowAllData
 If bClearContents Then
 lRow = .Cells(.Rows.Count, ColumnForSize).End(xlUp).row
 lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 If lRow > 1 Then .Cells(1, 1).Resize(lRow, lCol).ClearContents
 End If
 If bOmitFirstRow Then
 For i = LBound(vArray, 2) To UBound(vArray, 2)
 vArray(LBound(vArray), i) = vArray(UBound(vArray), i)
 vArray(UBound(vArray), i) = ""
 Next
 x = 1
 End If
 If Not (Not vArray()) Then
 If bLastRow Then
 lRow = .Cells(.Rows.Count, ColumnForSize).End(xlUp).row + 1
 .Cells(lRow, 1).Resize(UBound(vArray) - x, UBound(vArray, 2)) = vArray()
 Else
 .Cells(1, 1).Resize(UBound(vArray) - x, UBound(vArray, 2)) = vArray()
 End If
 End If
End With
EndFunction:
Exit Function
ErrH:
Debug.Print "Worksheet name '" & SheetName & "' not found."
Resume EndFunction
End Function