Splitting variable length sections into separate worksheets 1

[DPlank]

Hi,

I seem to have a problem with my arrays (?) on this. I have a sheet in excel which relates to a number of tests. The number of tests varies, and the length of(number of rows occupied by) each test can vary as well. I need to reformat this to split each test into its own worksheet. The code I'm using is below:

Public Sub GrabData()
Application.ScreenUpdating = False
Cells(5, "G").Select ' This is the first test - find out how many tests there are to cover
NumTests = 1
While ActiveCell.Row < 65536
    ReDim TestStart(NumTests) 'This allows us to vary the number of tests we are looking at
    TestStart(NumTests) = Int(ActiveCell.Row)' Set the value of the array to the starting cell of the next test
    Selection.End(xlDown).Select
    NumTests = NumTests + 1
Wend
' Create a new sheet for each test and copy the test contents to it
For LoopCount = 1 To NumTests
    Worksheets.Add
    ActiveSheet.Name = LoopCount & " added"
Next LoopCount

' Gather the data for each test and copy it to its worksheet
Sheets("Planning Report3").Select
LoopCount = 1
For LoopCount = 1 To NumTests
    StartCell = "A" & TestStart(LoopCount) ' StartCell should be "A5" in first case
    If (LoopCount = NumTests) Then
        EndCell = "H65536"  'Use end of worksheet if on last array element
    Else
        EndCell = "H" & (TestStart(LoopCount + 1) - 1) ' Otherwise use the start of the next test minus 1 to get the range for the test
    End If
    Range(StartCell, EndCell).Copy ' Copy the test
    Sheets(LoopCount & " added").Select ' swap to the relevant sheet
    Cells(1, 1).Select 'Pick a start
    ActiveSheet.Paste ' Paste the copied test
Next LoopCount

I'm not sure where the problem is in this case, but I'm seeing 0 as the value in the third loop (second For loop) for the array elements although when the array is set in the first place, hovering over it seems to suggest that the correct values are being set. This seems to happen until array element 10, where it sets a value of 599 (this is the correct row for the last test). There are 11 elements in the array - although NumTests reports 12, this is due to the last increment of the variable in the first loop - haven't amended that just yet.

Anyone able to help out?

Cheers,
Dave

"Yes, I'll stop finding bugs in the software - as soon as you stop writing bugs into the software." <-- Me

For all your testing needs: Forum1393

 

[PHV]

ReDim [!]Preserve[/!] TestStart(NumTests)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[SkipVought]

Hi,

Why not use a PivotTable to report any test?

Or use the AutoFilter to display the data for a test.

Skip,

_[red][/red]

 

[DPlank]

PHV - Thanks!
Skip - 1. Dunno how they're used - never got round to learning them
2. I need them separately for review by separate team members. Once the tests are split, I'll be sending them out. The variable length and so on (as the file is imported in the first place) makes it difficult to see any autofilter control that would operate successfully.

Cheers,
Dave

"Yes, I'll stop finding bugs in the software - as soon as you stop writing bugs into the software." <-- Me

For all your testing needs: Forum1393

 

[firefytr]

While I'm not sure what the end result is here, you could do away with the Selects and even trim your loops down ...

Public Sub GrabData()
    Dim ws As Worksheet, wsPR As Worksheet, wsTEMP As Worksheet
    Dim TestStart() As Variant, i As Long, StartCell As String, EndCell As String
    Application.ScreenUpdating = False
    Set ws = Sheets("Sheet1") '## SET FIRST SHEET HERE
    Set wsPR = Sheets("Planning Report3") '## SET SECOND SHEET HERE
    numtests = 1
    i = 5
    While i < ws.Rows.Count
        ReDim Preserve TestStart(numtests)    'This allows us to vary the number of tests we are looking at
        TestStart(numtests) = i   ' Set the value of the array to the starting cell of the next test
        i = ws.Cells(i, "G").End(xlDown).Row
        numtests = numtests + 1
        Set wsTEMP = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        wsTEMP.Name = LoopCount & " added"
        Set wsTEMP = Nothing
    Wend
    ' Gather the data for each test and copy it to its worksheet
    LoopCount = 1
    For LoopCount = 1 To numtests
        StartCell = "A" & TestStart(LoopCount)    ' StartCell should be "A5" in first case
        If (LoopCount = numtests) Then
            EndCell = "H65536"  'Use end of worksheet if on last array element
        Else
            EndCell = "H" & (TestStart(LoopCount + 1) - 1)    ' Otherwise use the start of the next test minus 1 to get the range for the test
        End If
        wsPR.Range(StartCell & ":" & EndCell).Copy Destination:=Sheets(LoopCount & " added").Cells(1, 1)
    Next LoopCount
End Sub

I would think you could get rid of your last loop and use only one, but I'd need to know the data structure and total scope of the application.

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci