Solved: VBA code to copy rows from one sheet to another based on 2 criteria?

[Danny]

I am wanting to copy rows that contain certain values to another spreadsheet, but place them in 1 of 3 sections based on a second criteria. For instance if a row in sheet1 contains "D34" in column A then i want to copy it to sheet 2, but I want to place it in the PRIOR, PRESENT, or FUTURE section based on what is in column C.
So sheet1 is the info i have and sheet2 is what i ,want after it is populated.
Sheet1-
Col. A / Col. B / Col. C
1 D34 / $4.00 / Current
2 A42 / $6.34 / Prior
3 D34 / $7.09 / Prior
4 C72 / $8.78 / Future
5 D34 / $0.98 / Future
6 D34 / $9.01 / Prior

Sheet2-
Prior Section
D34 / $7.09 / Prior
D34 / $9.01 / Prior

Current Section
D34 / $4.00 / Current

Future Section
D34 / $0.98 / Future

[MaximS]

try that:

[vba]
Sub Copier()

Dim Wb As Workbook
Dim Sh, Sh1 Worksheet
Dim LRow, i, j, k, l As Long

Set Wb = ThisWorkbook
Set Sh = Wb.Worksheets(1)
Set Sh1 = Wb.Worksheets(2)

LRow = Sh.Range("A" & Rows.Count).End(xlUp).Row

'First row of Prior section
j = 2
'First row of Current section
k = 10
'First row of Future section
l = 15

With Sh
For i = 1 To LRow
If .Cells(i, "A").Value = "D34" Then
Section = .Cells(i, "C").Value
Select Case Section
Case Prior
Sh1.Range("A" & j & ":C" & j).Value = _
.Range("A" & i & ":C" & i).Value
j = j + 1
Case Current
Sh1.Range("A" & k & ":C" & k).Value = _
.Range("A" & i & ":C" & i).Value
k = k + 1
Case Future
Sh1.Range("A" & l & ":C" & l).Value = _
.Range("A" & i & ":C" & i).Value
l = l + 1
End Select
End If
Next i
End With
End Sub
[/vba]

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim iPrior As Long, iCurrent As Long, iFuture As Long
Dim aryCurrent, aryPrior, aryFuture
Dim cell As Range
Dim Sh As Worksheet

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
ReDim aryPrior(1 To LastRow, 1 To 3)
ReDim aryCurrent(1 To LastRow, 1 To 3)
ReDim aryFuture(1 To LastRow, 1 To 3)
For i = 1 To LastRow

With .Cells(i, TEST_COLUMN)

Select Case .Offset(0, 2).Value

Case "Prior"
iPrior = iPrior + 1
aryPrior(iPrior, 1) = .Value
aryPrior(iPrior, 2) = .Offset(0, 1).Value
aryPrior(iPrior, 3) = .Offset(0, 2).Value

Case "Current"
iCurrent = iCurrent + 1
aryCurrent(iCurrent, 1) = .Value
aryCurrent(iCurrent, 2) = .Offset(0, 1).Value
aryCurrent(iCurrent, 3) = .Offset(0, 2).Value

Case "Future"
iFuture = iFuture + 1
aryFuture(iFuture, 1) = .Value
aryFuture(iFuture, 2) = .Offset(0, 1).Value
aryFuture(iFuture, 3) = .Offset(0, 2).Value
End Select
End With
Next i
End With

With Worksheets("Sheet2")

.Range("A1").Value = "Prior Section"
.Range("A2").Resize(iPrior, 3) = aryPrior

.Cells(iPrior + 3, "A").Value = "Current Section"
.Cells(iPrior + 4, "A").Resize(iCurrent, 3) = aryCurrent

.Cells(iPrior + iCurrent + 5, "A").Value = "Future Section"
.Cells(iPrior + iCurrent + 6, "A").Resize(iFuture, 3) = aryCurrent
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
[/vba]

[Danny]

XLD,
Thank you. That is a pretty impressive code. The only other thing is that i am wanting to copy only the rows that contain "D34" in column A. And the Value ("D34") that acts as the criteria for whether or not to copy will be derived from a cell on sheet3.range("A1"). So, for example if the value in Sheet3.Range("A1") is "D34" then only the rows containing "D34" in column A of Sheet1 would move to Sheet2 in one of the 3 Sections.

I have been trying to do this with an IF, THEN statement to compare these values inside of a FOR EACH , IN , NEXT, but i am not having much luck.

Any more ideas you might have would be greatly appretiated.
Thanks again,
Danny

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim iPrior As Long, iCurrent As Long, iFuture As Long
Dim aryCurrent, aryPrior, aryFuture
Dim CheckValue As String

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

CheckValue = Worksheets("Sheet3").Range("A1").Value

With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
ReDim aryPrior(1 To LastRow, 1 To 3)
ReDim aryCurrent(1 To LastRow, 1 To 3)
ReDim aryFuture(1 To LastRow, 1 To 3)
For i = 1 To LastRow

With .Cells(i, TEST_COLUMN)

If .Value = CheckValue Then

Select Case .Offset(0, 2).Value

Case "Prior"
iPrior = iPrior + 1
aryPrior(iPrior, 1) = .Value
aryPrior(iPrior, 2) = .Offset(0, 1).Value
aryPrior(iPrior, 3) = .Offset(0, 2).Value

Case "Current"
iCurrent = iCurrent + 1
aryCurrent(iCurrent, 1) = .Value
aryCurrent(iCurrent, 2) = .Offset(0, 1).Value
aryCurrent(iCurrent, 3) = .Offset(0, 2).Value

Case "Future"
iFuture = iFuture + 1
aryFuture(iFuture, 1) = .Value
aryFuture(iFuture, 2) = .Offset(0, 1).Value
aryFuture(iFuture, 3) = .Offset(0, 2).Value
End Select
End If
End With
Next i
End With

With Worksheets("Sheet2")

.Columns("A:C").ClearContents

.Range("A1").Value = "Prior Section"
If Not IsEmpty(aryPrior(1, 1)) Then .Range("A2").Resize(iPrior, 3) = aryPrior

.Cells(iPrior + 3, "A").Value = "Current Section"
If Not IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + 4, "A").Resize(iCurrent, 3) = aryCurrent

.Cells(iPrior + iCurrent + 5, "A").Value = "Future Section"
If Not IsEmpty(aryFuture(1, 1)) Then .Cells(iPrior + iCurrent + 6, "A").Resize(iFuture, 3) = aryCurrent
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
[/vba]

[Danny]

xld,
You are brilliant!!
the only thing is that it is not picking up the future section. I am trying to figure out why but i am pretty new to VBA and am having trouble keeping up with your codes.
thanks again.

[Bob Phillips]

It picks up Future for me. I have just run it again for D34 and that is showing the #4.00 amount.

[Bob Phillips]

Just spotted tyhe problem, I was dropping the Current array into the Future section (copy paste error)

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim iPrior As Long, iCurrent As Long, iFuture As Long
Dim aryCurrent, aryPrior, aryFuture
Dim CheckValue As String

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

CheckValue = Worksheets("Sheet3").Range("A1").Value

With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
ReDim aryPrior(1 To LastRow, 1 To 3)
ReDim aryCurrent(1 To LastRow, 1 To 3)
ReDim aryFuture(1 To LastRow, 1 To 3)
For i = 1 To LastRow

With .Cells(i, TEST_COLUMN)

If .Value = CheckValue Then

Select Case .Offset(0, 2).Value

Case "Prior"
iPrior = iPrior + 1
aryPrior(iPrior, 1) = .Value
aryPrior(iPrior, 2) = .Offset(0, 1).Value
aryPrior(iPrior, 3) = .Offset(0, 2).Value

Case "Current"
iCurrent = iCurrent + 1
aryCurrent(iCurrent, 1) = .Value
aryCurrent(iCurrent, 2) = .Offset(0, 1).Value
aryCurrent(iCurrent, 3) = .Offset(0, 2).Value

Case "Future"
iFuture = iFuture + 1
aryFuture(iFuture, 1) = .Value
aryFuture(iFuture, 2) = .Offset(0, 1).Value
aryFuture(iFuture, 3) = .Offset(0, 2).Value
End Select
End If
End With
Next i
End With

With Worksheets("Sheet2")

.Columns("A:C").ClearContents

.Range("A1").Value = "Prior Section"
If Not IsEmpty(aryPrior(1, 1)) Then .Range("A2").Resize(iPrior, 3) = aryPrior

.Cells(iPrior + 3, "A").Value = "Current Section"
If Not IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + 4, "A").Resize(iCurrent, 3) = aryCurrent

.Cells(iPrior + iCurrent + 5, "A").Value = "Future Section"
If Not IsEmpty(aryFuture(1, 1)) Then .Cells(iPrior + iCurrent + 6, "A").Resize(iFuture, 3) = aryFuture
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
[/vba]

[rinser]

I wish the presented code would have some more comments. I am newbie and would really appreciate if the steps and logic would be explained.
The code looks quite impressive, I wish I could understand it all...

[Bob Phillips]

Sorry, I don't do comments.

[Danny]

I have added a little bit to the code. Now i am wanting to add some formulas. Also, any ideas to clean up or simplify this code would be appreciated.

I am wanting column H to contain a formula that subtracts column G (the value in column G will be added manually after the sub runs) from column F (H=F-G) for each row.

I would also like to total the columns F, G, H for each section ( Prior,Current, Future). Then a Row at the bottom that adds those 3 totals.

Thanks,
Danny



[VBA]
Public Sub ProcessData5()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim iPrior As Long, iCurrent As Long, iFuture As Long

Dim aryCurrent, aryPrior, aryFuture
Dim aryHdr
Dim CheckValue As String
Dim Wb As Workbook

Set Wb = ThisWorkbook
Ahdr = "SERVNBR"
Bhdr = "INVNBR"
Chdr = "BLK"
Dhdr = "LN#"
Ehdr = "CHL LOAN#"
Fhdr = "LN LOSS AMT"
Ghdr = "APPROVED"
Hhdr = "DIFFERENCE"
iHdr = "Description"
Jhdr = "Comments"
Khdr = "Comments2"
ReDim aryHdr(1, 1 To 11)
aryHdr(0, 1) = Ahdr
aryHdr(0, 2) = Bhdr
aryHdr(0, 3) = Chdr
aryHdr(0, 4) = Dhdr
aryHdr(0, 5) = Ehdr
aryHdr(0, 6) = Fhdr
aryHdr(0, 7) = Ghdr
aryHdr(0, 8) = Hhdr
aryHdr(0, 9) = iHdr
aryHdr(0, 10) = Jhdr
aryHdr(0, 11) = Khdr

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

CheckValue = Wb.Worksheets(2).Range("A1").Value

With Wb.Worksheets(1)

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
ReDim aryPrior(1 To LastRow, 1 To 13)
ReDim aryCurrent(1 To LastRow, 1 To 13)
ReDim aryFuture(1 To LastRow, 1 To 13)
For i = 1 To LastRow

With .Cells(i, TEST_COLUMN)

If .Value = CheckValue Then

Select Case .Offset(0, -1).Value

Case "CM FL"
iPrior = iPrior + 1
aryPrior(iPrior, 1) = .Value
aryPrior(iPrior, 2) = .Offset(0, 1).Value
aryPrior(iPrior, 3) = .Offset(0, 2).Value
aryPrior(iPrior, 4) = .Offset(0, 3).Value
aryPrior(iPrior, 5) = .Offset(0, 4).Value
aryPrior(iPrior, 6) = .Offset(0, 5).Value
aryPrior(iPrior, 7) = .Offset(0, 6).Value
aryPrior(iPrior, 8) = .Offset(0, 7).Value '(F-G)
aryPrior(iPrior, 9) = .Offset(0, 8).Value
aryPrior(iPrior, 10) = .Offset(0, 9).Value
aryPrior(iPrior, 11) = .Offset(0, 10).Value
aryPrior(iPrior, 12) = .Offset(0, 11).Value
aryPrior(iPrior, 13) = .Offset(0, 12).Value
Case "Supp"
iCurrent = iCurrent + 1
aryCurrent(iCurrent, 1) = .Value
aryCurrent(iCurrent, 2) = .Offset(0, 1).Value
aryCurrent(iCurrent, 3) = .Offset(0, 2).Value
aryCurrent(iCurrent, 4) = .Offset(0, 3).Value
aryCurrent(iCurrent, 5) = .Offset(0, 4).Value
aryCurrent(iCurrent, 6) = .Offset(0, 5).Value
aryCurrent(iCurrent, 7) = .Offset(0, 6).Value
aryCurrent(iCurrent, 8) = .Offset(0, 7).Value '(F-G)
aryCurrent(iCurrent, 9) = .Offset(0, 8).Value
aryCurrent(iCurrent, 10) = .Offset(0, 9).Value
aryCurrent(iCurrent, 11) = .Offset(0, 10).Value
aryCurrent(iCurrent, 12) = .Offset(0, 11).Value
aryCurrent(iCurrent, 13) = .Offset(0, 12).Value

Case "RA"
iFuture = iFuture + 1
aryFuture(iFuture, 1) = .Value
aryFuture(iFuture, 2) = .Offset(0, 1).Value
aryFuture(iFuture, 3) = .Offset(0, 2).Value
aryFuture(iFuture, 4) = .Offset(0, 3).Value
aryFuture(iFuture, 5) = .Offset(0, 4).Value
aryFuture(iFuture, 6) = .Offset(0, 5).Value
aryFuture(iFuture, 7) = .Offset(0, 6).Value
aryFuture(iFuture, 8) = .Offset(0, 7).Value ' (F-G)
aryFuture(iFuture, 9) = .Offset(0, 8).Value
aryFuture(iFuture, 10) = .Offset(0, 9).Value
aryFuture(iFuture, 11) = .Offset(0, 10).Value
aryFuture(iFuture, 12) = .Offset(0, 11).Value
aryFuture(iFuture, 13) = .Offset(0, 12).Value

End Select
End If
End With
Next i
End With
Workbooks.Add (xlWBATWorksheet)
ChDir "C:\Users\Owner\Desktop"
ActiveWorkbook.SaveAs Filename:="C:\Users\Owner\Desktop\" & CheckValue & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

With Workbooks(CheckValue).Worksheets(1)



.Range("A1").Value = "Prior"
.Range("A1").Font.Bold = True
If Not IsEmpty(aryPrior(1, 1)) Then .Range("A2").Resize(iPrior, 13) = aryHdr
If Not IsEmpty(aryPrior(1, 1)) Then .Range("A2").EntireRow.Interior.ColorIndex = 4

If Not IsEmpty(aryPrior(1, 1)) Then .Range("A3").Resize(iPrior, 13) = aryPrior
'Total Columns F,G &H
.Cells(iPrior + 3, "A").Value = "PriorTotal"
.Cells(iPrior + 3, "A").Font.Bold = True
.Cells(iPrior + 3, "A").Font.Underline = True
.Cells(iPrior + 3, "A").EntireRow.Interior.ColorIndex = 8

.Cells(iPrior + 7, "A").Value = "Current"
.Cells(iPrior + 7, "A").Font.Bold = True
If Not IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + 8, "A").Resize(iCurrent, 13) = aryHdr
If Not IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + 8, "A").EntireRow.Interior.ColorIndex = 4

If Not IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + 9, "A").Resize(iCurrent, 13) = aryCurrent
'Total Columns F,G &H
.Cells(iPrior + iCurrent + 9, "A").Value = "Current TOTAL"
.Cells(iPrior + iCurrent + 9, "A").Font.Bold = True
.Cells(iPrior + iCurrent + 9, "A").Font.Underline = True
.Cells(iPrior + iCurrent + 9, "A").EntireRow.Interior.ColorIndex = 8


.Cells(iPrior + iCurrent + 12, "A").Value = "Future"
.Cells(iPrior + iCurrent + 12, "A").Font.Bold = True

If Not IsEmpty(aryFuture(1, 1)) Then .Cells(iPrior + iCurrent + 13, "A").Resize(iFuture, 13) = aryHdr
If Not IsEmpty(aryFuture(1, 1)) Then .Cells(iPrior + iCurrent + 13, "A").EntireRow.Interior.ColorIndex = 4

If Not IsEmpty(aryFuture(1, 1)) Then .Cells(iPrior + iCurrent + 14, "A").Resize(iFuture, 13) = aryFuture
'Total Columns F,G &H
.Cells(iPrior + iCurrent + iFuture + 14, "A").Value = "Future Total"
.Cells(iPrior + iCurrent + iFuture + 14, "A").Font.Bold = True
.Cells(iPrior + iCurrent + iFuture + 14, "A").Font.Underline = True
.Cells(iPrior + iCurrent + iFuture + 14, "A").EntireRow.Interior.ColorIndex = 8
End With
Workbooks(CheckValue).Save
Workbooks(CheckValue).Close
With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With


End Sub
[/VBA]

[mdmackillop]

Instead of
[VBA]aryPrior(iPrior, 1) = .Value
aryPrior(iPrior, 2) = .Offset(0, 1).Value
aryPrior(iPrior, 3) = .Offset(0, 2).Value
aryPrior(iPrior, 4) = .Offset(0, 3).Value
aryPrior(iPrior, 5) = .Offset(0, 4).Value
aryPrior(iPrior, 6) = .Offset(0, 5).Value
aryPrior(iPrior, 7) = .Offset(0, 6).Value
aryPrior(iPrior, 8) = .Offset(0, 7).Value '(F-G)
aryPrior(iPrior, 9) = .Offset(0, 8).Value
aryPrior(iPrior, 10) = .Offset(0, 9).Value
aryPrior(iPrior, 11) = .Offset(0, 10).Value
aryPrior(iPrior, 12) = .Offset(0, 11).Value
aryPrior(iPrior, 13) = .Offset(0, 12).Value
[/VBA]
why not loop

[VBA]
For x = 1 To 13
aryPrior(iPrior, x) = .Offset(0, x - 1).Value
Next
[/VBA]

[Anomandaris]

I'm confused, I just tried this , this code doesnt copy anything except the title of the different sections 'Prior' 'Current' and Future'

[Bob Phillips]

why not loop

[VBA]
For x = 1 To 13
aryPrior(iPrior, x) = .Offset(0, x - 1).Value
Next
[/VBA]

Because it is slower and obfuscates the code.

With the number of array items, I would create a separate proedure to load a variable first dimension, and call that passing the dimension index.

[Bob Phillips]

I'm confused, I just tried this , this code doesnt copy anything except the title of the different sections 'Prior' 'Current' and Future'

The data layout has changed from that originally shown.

[Danny]

My apologies to everyone. I posted the wrong code (and really confused things). Hopefully this will make more sense.
I am wanting column E to contain a formula that subtracts column D (the value in column D MAY be added or changed manually after the sub runs) from column B (E=B-D) for each row.

I would also like to total the columns B, D and E for each section (Prior, Current, Future). Then a Row grand total at the bottom that Totals B, D and E for all 3 sections.

Thanks,
Danny
Sheet3
Cell A1 contains the CheckValue of D34
Sheet1-
Col. A / Col. B / Col. C /Col. D
1 D34 / $4.00 / Current /$2.00
2 A42 / $6.34 / Prior /$4.35
3 D34 / $7.09 / Prior /$7.09
4 C72 / $8.78 / Future /$6.45
5 D34 / $0.98 / Future /$0.00
6 D34 / $9.01 / Prior /$7.98

Sheet2- ‘(AS IT IS NOW WITH THIS CODE)
Col. A / Col. B / Col. C /Col. D

Prior Section
D34 / $7.09 / Prior /$7.09
D34 / $9.01 / Prior /$7.98

Current Section
D34 / $4.00 / Current/$2.00

Future Section
D34 / $0.98 / Future /$0.00


Sheet2 ‘(THE DESIRED OUTCOME)

Col. A / Col. B / Col. C /Col. D /Col. E
Prior Section
D34 / $7.09 / Prior /$7.09 /$0.00
D34 / $9.01 / Prior /$7.98 /$1.03
Total/$16.10/" " /$15.07 /$1.03 ‘(Total Col. B,D & E for Prior)

Current Section
D34 / $4.00 / Current/$2.00 /$2.00
Total/$4.00 /" " /$2.00 /$2.00 ‘(Total Col. B,D & E for Current)

Future Section
D34 / $0.98 / Future /$0.00 /$0.98
Total/$$0.98/" " /$0.00 /$0.98 ‘(Total Col. B,D & E for Future)
Grand Total
Totals/$21.08/" " /$17.07 /$4.01 '(Total Col. B,D & E for ALL sections)

Here is the code so far.

[vba]
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim iPrior As Long, iCurrent As Long, iFuture As Long
Dim aryCurrent, aryPrior, aryFuture
Dim CheckValue As String

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

CheckValue = Worksheets("Sheet3").Range("A1").Value

With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
ReDim aryPrior(1 To LastRow, 1 To 5)
ReDim aryCurrent(1 To LastRow, 1 To 5)
ReDim aryFuture(1 To LastRow, 1 To 5)
For i = 1 To LastRow

With .Cells(i, TEST_COLUMN)

If .Value = CheckValue Then

Select Case .Offset(0, 2).Value

Case "Prior"
iPrior = iPrior + 1
aryPrior(iPrior, 1) = .Value
aryPrior(iPrior, 2) = .Offset(0, 1).Value
aryPrior(iPrior, 3) = .Offset(0, 2).Value
aryPrior(iPrior, 4) = .Offset(0, 3).Value
aryPrior(iPrior, 5) = .Offset(0, 4).Value ' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) This Needs to = Columns B-D

Case "Current"
iCurrent = iCurrent + 1
aryCurrent(iCurrent, 1) = .Value
aryCurrent(iCurrent, 2) = .Offset(0, 1).Value
aryCurrent(iCurrent, 3) = .Offset(0, 2).Value
aryCurrent(iCurrent, 4) = .Offset(0, 3).Value
aryCurrent(iCurrent, 5) = .Offset(0, 4).Value ' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) This Needs to = Columns B-D

Case "Future"
iFuture = iFuture + 1
aryFuture(iFuture, 1) = .Value
aryFuture(iFuture, 2) = .Offset(0, 1).Value
aryFuture(iFuture, 3) = .Offset(0, 2).Value
aryFuture(iFuture, 4) = .Offset(0, 3).Value
aryFuture(iFuture, 5) = .Offset(0, 4).Value ' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) This Needs to = Columns B-D
End Select
End If
End With
Next i
End With

With Worksheets("Sheet2")

.Columns("A:E").ClearContents

.Range("A1").Value = "Prior Section"
If Not IsEmpty(aryPrior(1, 1)) Then .Range("A2").Resize(iPrior, 5) = aryPrior
'''''''' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) Row to Total Columns B,D & E for Prior section
.Cells(iPrior + 3, "A").Value = "Current Section"
If Not IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + 4, "A").Resize(iCurrent, 5) = aryCurrent
'''''''' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) Row to Total Columns B,D & E for Current section
.Cells(iPrior + iCurrent + 5, "A").Value = "Future Section"
If Not IsEmpty(aryFuture(1, 1)) Then .Cells(iPrior + iCurrent + 6, "A").Resize(iFuture, 5) = aryFuture
'''''''' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) Row to Total Columns B,D & E for Future section

'''''''' (NOTE TO EXPLAIN WHAT NEEDS TO BE DONE) Row to Total Columns B,D & E for All sections
End With


With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub[/font][/vba]