# Speeding up my code

#### dpaton05

##### Well-known Member
I have a table in my spreadsheet that goes from A-AP. It has visible columns up to column Q. From R to AP are hidden columns. The extra columns are hidden and they are just to work out certain information based on the data entered in the visible columns. For instance, I have a date that is entered in column A and in column Z I have this formula to work out the month the transaction needs to be recorded in based on the requirements of my workplace.
Excel Formula:
``=IF(MONTH(A5)=6,"June",TEXT(DATE(YEAR(A5),IF(DAY(A5)<26,MONTH(A5),MONTH(A5)+1),1), "mmmm"))``

In column AA
Excel Formula:
``=TEXT(DATE(YEAR(A5),IF(DAY(A5)<26,MONTH(A5),MONTH(A5)+1),1), "yyyy")``

That is just 2 of the columns. The table ends at the column AP with other formulas that derive their data from the visible cells

I have a copy procedure that looks at every row in the table and copies information from the row to 2 separate documents. These separate documents are financial year documents, broken up into monthly sheets. Parts of each row in the table are copied to monthly sheets in the 2 documents. For about 100 rows entered in the table, in takes around 5 minutes to run the code. This doesn't seem like I have developed it in the most efficient manner and I am sure it can be executed much faster.

I am still learning vba, so when I had something working, I didn't want to break it again so I left it. Other people helped me with most of it too so I couldn't change parts due to not knowing how.

I am not sure if it can be run faster but could someone look at my code and give a few ideas on how I could speed it up please? I have been told that the more you need to interact with the worksheet, the more it slows down. Maybe I should try and move alot of the additional, hidden columns into vba so it doesn't need to interact with the worksheet so much?

Here is my copy procedure.
You may notice that there is code relating to an hours register file that is commented out. I do not need it anymore at the moment but I may need it later.

VBA Code:
``````Sub cmdCopy()
'On Error GoTo ErrorMsg
Dim wsDst As Worksheet, wsHours As Worksheet, wsTrack As Worksheet, worker As String, wsSrc As Worksheet, tblrow As ListRow
Dim Combo As String, sht As Worksheet, tbl As ListObject
Dim LastRow As Long, DocYearName As String, Site As String, lr As Long, HoursRow As Long
Dim RowColor As Long, w As Window, r As Long, HoursRegister As String, ReportTracking As String
Application.ScreenUpdating = False

'assign values to variables
Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
Set sht = ThisWorkbook.Worksheets("Costing_tool")
Site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
'Check if each row has a date, service and requesting organisation
For Each tblrow In tbl.ListRows
If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
Exit Sub
End If
Next tblrow
For Each tblrow In tbl.ListRows
'Define combo as the month to be recorded in
Combo = tblrow.Range.Cells(1, 26).Value
'If column 8 for the row is blank...
If Not tblrow.Range(1, 8).Value = "" Then
'worker variable is defined as the value in column 8 of the row
worker = tblrow.Range.Cells(1, 8).Value
Else
'otherwise, "not allocated" is assigned to the worker variable.
'this is used in the hours register to identify which sheet to place the hours in
worker = "Not allocated"
End If
'defines HoursRegister as the hours register filename that is stored in column 38 for the row
'HoursRegister = tblrow.Range.Cells(1, 38)
'defines ReportTracking as the report tracking filename that is stored in column 39 for the row
ReportTracking = tblrow.Range.Cells(1, 39)
Select Case Site
Case "Wes"
Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = tblrow.Range.Cells(1, 37).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select
Case "Riv"
Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = tblrow.Range.Cells(1, 42).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select

End Select
If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
'If Not isFileOpen(HoursRegister & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Hours Register" & "\" & Site & "\" & HoursRegister & ".xlsm"
If Not isFileOpen(ReportTracking & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Report Tracking" & "\" & Site & "\" & ReportTracking & ".xlsm"
'Set wsHours = Workbooks(HoursRegister).Worksheets(worker)
Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
Set wsTrack = Workbooks(ReportTracking).Worksheets(Combo)
lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row

'Copy the pricing cells from the quoting tool to the allocation sheet for use in calculating late cancels
Workbooks(DocYearName).Worksheets("sheet2").Range("A4:E12").Value = Data.Range("A4:E12").Value

'With wsHours
'this copies the date column in the tblCosting
'HoursRow = .Range("A" & Rows.Count).End(xlUp).Row
'tblrow.Range(, 1).Copy
'this pastes it into column A of hours register file
'.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
'tblrow.Range(, 4).Copy
'this pastes it into column B of hours register file
'.Range("B" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
'tblrow.Range(, 3).Copy
'this pastes it into column A of hours register file
'.Range("C" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the hours column in the tblCosting
'tblrow.Range(, 9).Copy
'this pastes it into column A of hours register file
'.Range("D" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'End With
With wsTrack
'this copies the date column in the tblCosting
tblrow.Range(, 1).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 4).Copy
'this pastes it into column B of the report tracking file
.Range("A" & Rows.Count).End(xlUp).Offset(, 1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 5).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(, 2).PasteSpecial xlPasteFormulasAndNumberFormats
End With
With wsDst
'This sets column width of request number column so it can be read and is not xxxxx
.Columns("C:C").ColumnWidth = 8

'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range.Resize(, 7).Copy
'This pastes in the figures in the first 7 columns starting in column A
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range(, 10).Copy

'This pastes in the figures in the first 7 columns starting in column A
.Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats

'Overwrites the numbers pasted to column I with a formula
.Range("I" & Rows.Count).End(xlUp).Offset(1).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
'Overwrites the numbers pasted to column L with a formula
.Range("J" & Rows.Count).End(xlUp).Offset(1).Formula = "=RC[-1]+RC[-2]"
'Adds currency formatting to total ex gst column
.Columns(8).NumberFormat = "\$#,##0.00"
'Adds Australian date format to date column
'.Range("A:A").NumberFormat = "dd/mm/yyyy"

'sort procedure copied from vba
wsDst.Sort.SortFields.Clear
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(DocYearName).Worksheets(Combo).Sort
'set range to sort of A3 to AO
.SetRange Range("A3:AO" & lr)
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Next tblrow
Application.CutCopyMode = False
Application.ScreenUpdating = True
Exit Sub

'ErrorMsg:
'    Select Case Err.Number
'        Case 53
'            MsgBox "Enable macros needs to be selected"
'    End Select
End Sub``````

Last edited by a moderator:

#### dpaton05

##### Well-known Member
I thought I would have a go at this but there is a lot I don't understand.

a.

VBA Code:
``For i = 1 To UBound(inarr, 1)``

this line of code starts the counter at 1, it will go until the upper limit in terms of rows in the first column of the array stored in inarr?

If it was UBound(1, inarr), the code would cycle through all the columns, correct?

Does it step through by 1 or does in 1 in (inarr, 1) refer to the first column?

Regarding your method in post 42, this is broken up into the points from the post

1. I understand this part loading the table/range into a variant, which becomes an array. Anyway, this bit has already been done.

2. Looping through each row in the table in the array, is it done with the following code?
For i = 1 To UBound(inarr, 1)?

2a. Check column 39, copy first name to a new dictionary ( Reporttracking dictionary)
How do you check column 39 and add it to new dictionary? I looked at this but I wasn't sure what to do.

2b. Check each row column 39if the name changes add it to the dictionary
Could you help me with the syntax to do this bit also please?

3a. Perform the logic to check whether Docyearname file is from column 36,37 or 42, add this name to a new variant array with the same number of elements as there are row in tblcosting. ( we are saving this to use later, let’s call it DYnames )
Do I include the logic I used to find the DocYearName filename?

My code/logic was
VBA Code:
``````Select Case Site
Case "Wes"
Select Case inarr(i, 6)
'                    Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
'DocYearName = tblrow.Range.Cells(1, 37).Value
DocYearName = inarr(i, 37)
Case Else
'DocYearName = tblrow.Range.Cells(1, 36).Value
DocYearName = inarr(i, 36)
End Select
Case "Riv"
'Select Case tblrow.Range.Cells(1, 6).Value
Select Case inarr(i, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = inarr(i, 42)
Case Else
DocYearName = inarr(i, 36)
End Select

End Select``````

I am not sure how to then add this to a variant array with the same number of rows as in tblCosting, could you please help me with that?

I also don't know what to do with DYnames?

3b. Add each name to a second dictionary ( Docyearname dictionary)
This step involves adding this to a separate dictionary. How do you do this and what is the point?

3c: I understand that at the end of this, I write next to go to the next row and at the end of the rows, the loop is ended.

4:Set up loop to loop round all the files in the Reporttracking dictionary ( might only be one)

Set up inside loop to loop through each row in tblcosting,

With this step, I thought that you would need to loop through the table first but can you help me please as I have no idea how to setup the syntax for these bits?

4a: If the name in column 39 is the same as the file name we have open then copy the inarr data to two new output arrays which have the same number of rows as inarr, one is for column A and the other is for column D and E . ( this assumes that we can’t write into columns B and C)
Again, please can you help me with the syntax to code this bit as I have no idea how to write this bit?

4b: at end of inside loop write output arrays to the reporttracking file
I don't know how to do this, please can you help me with it?

4c: Sort the file
Do I use the standard sort code for this?
VBA Code:
``````         With wsDst
lr = .Cells(Rows.Count, "A").End(xlUp).Row ' line added to make sure you sort the whole sheet if rows have been added
.Sort.SortFields.Clear
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Columns("C:C").ColumnWidth = 8
End With

With Workbooks(DocYearName).Worksheets(Combo)
lr = .Cells(Rows.Count, "A").End(xlUp).Row ' line added to make sure you sort the whole worksheet
'set range to sort of A3 to AO
.Sort.SortFields.Add Key:=Range("B4:B" & lr) ' line added since you hadn't put a sort column in I chose B!!!
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With``````

4dc : go round the outside loop to do the next report tracking file
From this point onwards, I do not know how to code any of these, except 5c. Actually, I don't think I have known much of the code required so far. Can you please help me with the syntax for them?

5:Set up loop to loop round all the files in the Docyearname dictionary ( might only be one)

Set up inside loop to loop through each row in tblcosting,

5a: If the name DYnames is the same as the file name we have open then copy the inarr data to one new output arrays which have the same number of rows as inarr, and 10 columns

5b: at end of inside loop write output arrays to the Docyearname file

5c: Sort the file
Do I use the standard sorting code as in 4c above or should I use different sort code using arrays or something similar?

5dc : go round the outside loop to do the next docyearname file

Thank you again for helping me

### Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

#### offthelip

##### Well-known Member
You need to do a bit of googling: google "Ubound VBA" to find out how Ubound works, it is not as you describe
Google "Excel Vba dictionary" there are lots of very good websites describing what dictionaries are and how to use them. I was planning to use a dictionary in a very simple way just to generate a unique list of names. I do this by adding all the names to the dictionary, if the name already exists it ignores it.
to check column 39 in the array in , just use 39 as the second index into inarr. e.g inarr(1,39) is the data in row 1 column 39
Your logic to select docyearname will stay the same.
to add the names to another array
VBA Code:
``````Dim filenarr()
ReDim filenarr(1 To UBound(inarr, 1))``````

' then in the middle of the loop just after your logic ad
VBA Code:
``filenarr(i) = Docyearname ' this will load the array with the name for that row``
I have written some code to show you a very basic use of a dictionary ( which is all you need) . Put a list of names in column A of a blank worksheet, make sure you have some duplicate names.
Then run this code, it adds the names to a dictionary and then loops through the dictionary to print each unique value to the immediate screen,
this is all the new stuff you need every thing else has already been covered in my code. I am already defining an output array and writing it to the worksheet. look at the use of out1 and out2
The sort remains the same
VBA Code:
``````Sub test()
Dim dict As Object                              ' this line
Set dict = CreateObject("Scripting.Dictionary") ' these two line define a dictionary called dict
lastrow = Cells(Rows.Count, "A").End(xlUp).Row ' these two lines load the data in column A of
namarr = Range(Cells(1, 1), Cells(lastrow, 1)) 'the workhseet into a variant arrray called namarr

' this loop loop through the dsata in column A of the worksheet ( now copied into Namarr)
For i = 1 To UBound(namarr, 1)
dict(namarr(i, 1)) = namarr(i, 1)  ' this line of code creates entry in the dictionary
' with a key given by Namarr(i,1) , which is hte data in column A
' if the key doesn't exist it create the key
' So effectively this is creating a list of unique values from column
Next i

' this code is just to show you what is in the dictionary:
noitems = dict.Count
Debug.Print " Number of items in dictionary " & noitems
Dim key As Variant
For Each key In dict.Keys
Debug.Print key
Next key
End Sub``````

#### dpaton05

##### Well-known Member
I was planning to use a dictionary in a very simple way just to generate a unique list of names. I do this by adding all the names to the dictionary,

What names were you going to add to the dictionary?

#### dpaton05

##### Well-known Member
I think I get it now, the names to add to the dictionary.

I tried to write some code for the guidelines you put in post 42 and this is all I got
VBA Code:
``````Sub cmdCopy()
Dim ReportTrackingDictionary As Object, LastRow As Long, inarr As Variant, i As Long
Set ReportTrackingDictionary = CreateObject("Scripting.dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

inarr = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting").DataBodyRange.Value
For i = 1 To UBound(inarr, 1)
ReportTrackingDictionary(inarr(i, 39)) = inarr(i, 1)
Next i
Dim site As String
site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value

For i = 1 To UBound(inarr, 1)
Select Case site
Case "Wes"
Select Case inarr(i, 6)
'                    Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
'DocYearName = tblrow.Range.Cells(1, 37).Value
DocYearName = inarr(i, 37)
Case Else
'DocYearName = tblrow.Range.Cells(1, 36).Value
DocYearName = inarr(i, 36)
End Select
Case "Riv"
'Select Case tblrow.Range.Cells(1, 6).Value
Select Case inarr(i, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = inarr(i, 42)
Case Else
DocYearName = inarr(i, 36)
End Select
End Select

Dim DocYearNameDictionary As Object
Set DocYearNameDictionary = CreateObject("scripting.dictionary")
For i = 1 To UBound(inarr, 1)
DocYearNameDictionary(DocYearName) = inarr(i, 1)
Next i
Next i

End Sub``````

I tried to write the code this code and the code that goes after this but I just couldn't work out what to write after the last next i, and I am not even sure if the code I wrote is correct. If you have time, can you help me with it and the remainder of the code please?

Thank you, I really appreciate this help as I am not very good at coding!!

#### offthelip

##### Well-known Member

that code looks exactly what I was expecting, well done!!
the next steps are:
We now have two list of filenames one for Reporttracking and one for Docyearname

So we deal with each of these separately:

Doing report tracking first:

4:Set up loop to loop round all the files in the Reporttracking dictionary ( might only be one)
In my dictionary example I showed you how to set up loop to loop through all items in a dictionary:
VBA Code:
``````Dim key As Variant
For Each key In dict.Keys
Debug.Print key
Next key``````

#### dpaton05

##### Well-known Member
Thankyou. It's funny that I got that right as i was doing it really fast, half expecting Bits of it to be wrong.

So after the last next i, do I include?

VBA Code:
``````Dim RTkey As Variant
For Each RTkey In ReportTrackingDictionary.Keys
Debug.Print RTkey
Next RTkey``````

I think this is the loop but I didn't know what to include where the code says debug.print.

#### offthelip

##### Well-known Member

In the outer loop first you open the filename which is given by the key RTkey, you already have the code to open the software. Then you set up a loop to go through inarr row by row.
There is one major difference now in this loop instead of writing the the results out to the worksheet every iteration , you write the results to another variant array . Just like I did with the out1 and out2, except this time you are going to write multiple rows to the arrays and only write it out when the loop is complete. So you need to change the definition of the output array to make it big enough to cope with all the rows that you write to it. So what i would do is declare the output array with the same number of rows as the input array then you know it will be big enough ( it doesn't matter if it is larger) . You need to keep a separate index to keep track of where the next blank row is on the output . So set up and index starting a 1 or 2 and increment each time you write a complete row out.
When you have done one file the outloop will take you to the second file.

#### dpaton05

##### Well-known Member
So, this is the whole procedure so far:

VBA Code:
``````Sub cmdCopy()
Dim ReportTrackingDictionary As Object, LastRow As Long, inarr As Variant, i As Long
Set ReportTrackingDictionary = CreateObject("Scripting.dictionary")
For i = 1 To UBound(inarr, 1)
ReportTrackingDictionary(inarr(i, 39)) = inarr(i, 1)
Next i

Dim site As String
site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

inarr = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting").DataBodyRange.Value
For i = 1 To UBound(inarr, 1)
Select Case site
Case "Wes"
Select Case inarr(i, 6)
'                    Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
'DocYearName = tblrow.Range.Cells(1, 37).Value
DocYearName = inarr(i, 37)
Case Else
'DocYearName = tblrow.Range.Cells(1, 36).Value
DocYearName = inarr(i, 36)
End Select
Case "Riv"
'Select Case tblrow.Range.Cells(1, 6).Value
Select Case inarr(i, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = inarr(i, 42)
Case Else
DocYearName = inarr(i, 36)
End Select
End Select

Dim DocYearNameDictionary As Object
Set DocYearNameDictionary = CreateObject("scripting.dictionary")
For i = 1 To UBound(inarr, 1)
DocYearNameDictionary(DocYearName) = inarr(i, 1)
Next i
Next i

Dim RTkey As Variant
For Each RTkey In ReportTrackingDictionary.Keys
If Not isFileOpen(RTkey & ".xlsm") Then Workbooks.Open ThisWorkbook.Path _
& "\" & "Report Tracking" & "\" & site & "\" & RTkey & ".xlsm"
For i = 1 To UBound(inarr, 1)

I am not sure what goes here???

Next i
Next RTkey

End Sub``````

I think I got that I needed a report tracking loop to open the report tracking files, but then I just got lost.

There is one major difference now in this loop instead of writing the the results out to the worksheet every iteration , you write the results to another variant array . Just like I did with the out1 and out2, except this time you are going to write multiple rows to the arrays and only write it out when the loop is complete

I didn't really understand what you did with out1 and out2

I think I need to back up a bit and make sure i have my understanding correct on all the code so far.

With this code
VBA Code:
``````        With wsTrack
lasttrack = .Cells(Rows.Count, "A").End(xlUp).Row + 1 ' find the next empty row on the wstrack sheet

.Range(.Cells(lasttrack, 1), .Cells(lasttrack, 1)) = inarr(i, 1)
' copy the 4th column of this row from tblcosting to the 1st column of the output array
out1(1, 1) = inarr(i, 4)
' copy the 5th column of this row from tblcosting to the 2nd column of the output array
out1(1, 2) = inarr(i, 5)
' copy the small output array to the worksheet on row lasttrack
.Range(.Cells(lasttrack, 2), .Cells(lasttrack, 3)) = out1
End With``````

What does this line of code do?
VBA Code:
``.Range(.Cells(lasttrack, 1), .Cells(lasttrack, 1)) = inarr(i, 1)``

I think I also need the date copied across too. It is stored in column 1 in tblCosting. Would I just need to change the following?
VBA Code:
``````            out1(1, 1) = inarr(i, 1)
out1(1, 2) = inarr(i, 4)
out1(1, 3) = inarr(i, 5)``````

I am sorry I am so slow to understand things.

#### offthelip

##### Well-known Member
I have updated your code to show you the next steps and added some comments to point out some things that need correcting.
I did come up with another question. I notice that in the reporttracking workbook , the worksheet the results need to be written to are defined in variable "combo" which is loaded form column 26. Does this change with the workbook or does it change independently of the workbook. The reason I ask is if one particular workbook always writes to the same worksheet then it is much simpler. However it it changes independent of the workbook then we need to set up another dictionary and another control loop
updated code:
VBA Code:
``````Sub cmdCopy3()

Dim ReportTrackingDictionary As Object, LastRow As Long, inarr As Variant, i As Long
' comment define output array but the size of it is defined later
Dim outcolA()
Dim outcolDE()
'comment : this section of code uses "inarr" as onme of the variables
'so it must go AFTER you have loaded inarr from the tblecostng
Set ReportTrackingDictionary = CreateObject("Scripting.dictionary")
For i = 1 To UBound(inarr, 1)
ReportTrackingDictionary(inarr(i, 39)) = inarr(i, 1)
Next i
'comment:  end of section
Dim site As String
site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Comment: this is where inarr is loaded
inarr = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting").DataBodyRange.Value
' comment now we know the size ofthe input array we can defein the size of the output arrays
' because we know they can't be larger than the input array. both have the same number of rows as the input table
ReDim outcolA(1 To UBound(inarr, 1), 1 To 1) ' this is one column wide
ReDim outcolDE(1 To UBound(inarr, 1), 1 To 2) ' this is two columns wide
For i = 1 To UBound(inarr, 1)
Select Case site
Case "Wes"
Select Case inarr(i, 6)
'                    Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
'DocYearName = tblrow.Range.Cells(1, 37).Value
DocYearName = inarr(i, 37)
Case Else
'DocYearName = tblrow.Range.Cells(1, 36).Value
DocYearName = inarr(i, 36)
End Select
Case "Riv"
'Select Case tblrow.Range.Cells(1, 6).Value
Select Case inarr(i, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = inarr(i, 42)
Case Else
DocYearName = inarr(i, 36)
End Select
End Select

Dim DocYearNameDictionary As Object
Set DocYearNameDictionary = CreateObject("scripting.dictionary")
For i = 1 To UBound(inarr, 1)
DocYearNameDictionary(DocYearName) = inarr(i, 1)
Next i
Next i

Dim RTkey As Variant
For Each RTkey In ReportTrackingDictionary.Keys
If Not isFileOpen(RTkey & ".xlsm") Then Workbooks.Open ThisWorkbook.Path _
& "\" & "Report Tracking" & "\" & site & "\" & RTkey & ".xlsm"
' commnet set up index for output array
indi = 1
For i = 1 To UBound(inarr, 1)
' comment check to see if this line of tblcosting needs to be written to the file we have got open
If inarr(i, 39) = RTkey Then
' write the data out to the output array
I am not sure what goes here???
outcolA(indi, 1) = inarr(i, 1) 'this copies the first column in the tblCosting to col A
outcolDE(indi, 1) = inarr(i, 4) 'this copies the 4th column in the tblCosting to Col D
outcolDE(indi, 2) = inarr(i, 5) 'this copies the 5th column in the tblCosting to Col E
' increment the output index
indi = indi + 1
End If
Next i
' write the output array to worksheet

Next RTkey

End Sub``````

#### offthelip

##### Well-known Member
VBA Code:
``.Range(.Cells(lasttrack, 1), .Cells(lasttrack, 1)) = inarr(i, 1)``
this line of code copies the value which came from the first column of tblcosting row number given by i ( which is now sitting in inarr) into Column A row number given by lasttrack

I think I also need the date copied across too. It is stored in column 1 in tblCosting. Would I just need to change the following?
column 1 of tblcosting is now in inarr(i,1) so you are already copying it with this line of code:
VBA Code:
``out1(1, 1) = inarr(i, 1)``
( and the one in the first line of this comment!!)

Replies
0
Views
107
Replies
8
Views
157
Replies
4
Views
112
Replies
0
Views
40
Replies
4
Views
130