ActiveSheet is not the ActiveSheet?

sjc · Oct 13, 2011

I'm trying to use a button in one workbook to open another Excel file, copy data from that file into an array, and paste some of the array data back into the original file (with the button) but on a different sheet than the sheet where the button is located. In the past, I've had no problems with this. I was just "updated" to Excel 2010 though from 2003 and things don't seem to work as they always have. Anyway, here are the basic steps:

1. Click button in Workbook A on Sheet 1

No problems with button activating macro in this step

2. VBA opens Workbook B (only one sheet) and reads all the data into an array

No problems with this step

3. VBA switches back to Wrkbk A and selects Sheet 2

I was using: Windows(Wrkbk A).Activate
Sheets(Sheet 2)).Select

I had problems in the next step though, so I switched this to:

Windows(Wrkbk A).Activate
ActiveWorkbook.Sheets(Sheet 2)).Activate

This seems to be working alright.

4. Clear old data from Sheet 2

I was using a Range().ClearContents command but it was clearing the data in the specified range on Sheet _1_, not Sheet 2.

So I switched to: Sheets(Sheet 2).Range(<data range>).ClearContents

This seems to be working alright.

5. VBA goes through the array and all records meeting a certain criterion have their data written to Wrkbk A, Sheet 2.

At first, as I cycled through the array, I was trying to write to Sheet 2 using a series of Cells(Row, Column).Value = DataArray(I).parameter statements. Even though I'd selected Sheet 2 though, it was still writing to Sheet 1.

So, I put in another 'ActiveWorkbook.Sheets(Sheet 2)).Activate' statement.

This didn't help though. So I changed all the write statements to have the form:

ActiveSheet.Cells(Row, Column).Value = DataArray(I).parameter

This now seems to be working (writing to Sheet 2), but it is INCREDIBLY slow. Each value takes about two seconds to write out. Since we're talking about somewhere in the neighborhood of 700,000 values to be written out, this is not acceptable if I want to finish before I retire (I'm 37).

So, I have two questions:
(1) Why does it seem that Excel isn't keeping track of the active sheet like I remember it doing in Excel 2003? Did something change? My memory is pretty good and I never had to continually specify the active sheet if I'd already done it once. I looked at a script I wrote a couple weeks ago to do a similar process and didn't have to fuss at all with specifying active sheets anywhere.

(2) Why is the write process from the array to the worksheet so slow?

Any advice would be fantastic. Thanks everyone.

-Sean

Andrew Poulsom · Oct 13, 2011

Welcome to MrExcel.

If your code is in a worksheet module unqualified Range properties will refer to that worksheet not the active worksheet.

There is generally no need to select objects to use their properties/methods. If you post your code someone may be able to tidy it up for you.

sjc · Oct 13, 2011

Alright, here's the basic code:

Private Sub GetDataBttn_Click()
Dim Response As VbMsgBoxResult
Dim SpecN As String ' Species
Dim FileN As String ' Name used in file name path
Dim Thm2 As String ' Theme 2 value to filter on in data file
Dim DataArray() As YldRec
Dim FileNameArray(1 To 6, 1 To 2) As String
Dim F As Integer, I As Long, J As Long, K As Long
Dim NumNewRecs As Long, NumOldRecs As Long, WriteRow As Long

' Make sure that each of the three combo boxes has a selection
If SpecLstCmbBox.Value = "" Or PhysRegCmbBox.Value = "" Or ModelListCmbBox.Value = "" Then
Response = MsgBox("Error: Not All Input Fields Specified", vbOKOnly, "Invalid Input Data")
Exit Sub
End If

'Application.ScreenUpdating = False

' ChDir "G:\resource_planning\Planning\SouthernYields\SilviSims"
If SpecLstCmbBox.Value = "Loblolly" Then
SpecN = "Lob"
Select Case PhysRegCmbBox.Value
Case "Lower Atlantic Coastal Plain"
FileN = "LACP_PUCP"
Thm2 = "LACP_PMRC"
Case "Piedmont and Upper Coastal Plain"
If ModelListCmbBox.Value = "PMRC East Coast Planted Lob" Then
FileN = "LACP_PUCP"
Thm2 = "PUCP_PMRC"
ElseIf ModelListCmbBox.Value = "VPI Planted Lob" Then
FileN = "LACP_PUCP"
Thm2 = "PUCP_PMRC"
End If
Case "West Gulf Coastal Plain"
FileN = "WGCP_WGHCP"
Thm2 = "WGCP_WG"
Case "West Gulf Hilly Coastal Plain"
If ModelListCmbBox.Value = "PMRC East Coast Planted Lob" Then
FileN = "WGCP_WGHCP"
Thm2 = "WGHCP_WG"
ElseIf ModelListCmbBox.Value = "VPI Planted Lob" Then
FileN = "WGCP_WGHCP"
Thm2 = "WGHCP_VPI"
End If
End Select
ElseIf SpecLstCmbBox.Value = "Slash" Then
SpecN = "Sla"
Select Case PhysRegCmbBox.Value
Case "Lower Atlantic Coastal Plain"
FileN = "LACP_PUCP"
Thm2 = "LACP_PMRC"
Case "Piedmont and Upper Coastal Plain"
If ModelListCmbBox.Value = "PMRC East Coast Planted Slash" Then
FileN = "LACP_PUCP"
Thm2 = "PUCP_PMRC"
ElseIf ModelListCmbBox.Value = "West Gulf Planted Slash" Then
FileN = "LACP_PUCP"
Thm2 = "PUCP_PMRC"
End If
Case "West Gulf Coastal Plain"
FileN = "WGCP_WGHCP"
Thm2 = "WGCP_WG"
Case "West Gulf Hilly Coastal Plain"
FileN = "WGCP_WGHCP"
Thm2 = "WGHCP_WG"
End Select

End If

' Create File List:
FileNameArray(1, 1) = "Graph_BA"
FileNameArray(2, 1) = "Graph_Inv"
FileNameArray(3, 1) = "Graph_Pulp"
FileNameArray(4, 1) = "Graph_Saw"
FileNameArray(5, 1) = "Graph_ThinVol"
FileNameArray(6, 1) = "Graph_TPA"
' Create Destination Sheet List:
FileNameArray(1, 2) = "BA"
FileNameArray(2, 2) = "Inv"
FileNameArray(3, 2) = "%Pulp"
FileNameArray(4, 2) = "%Saw"
FileNameArray(5, 2) = "ThinVol"
FileNameArray(6, 2) = "TPA"

For F = 1 To 6

' Open source data file if not already open:
If Not BookE(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx") Then
Workbooks.Open Filename:="C:\Work_General\SilviSIMS Southern Yields\Formatted Yield Files for Graphing Spreadsheet\" & _
FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx"
End If
Windows(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Activate

' Figure out number of rows
I = 0
'While Workbooks(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Cells(Rw, 1).Value <> ""
While ActiveSheet.Cells(I + 2, 1).Value <> ""
I = I + 1
Wend
NumNewRecs = I

' ReDim array and store all data into array
If I > 0 Then
ReDim DataArray(1 To NumNewRecs) As YldRec
For J = 1 To NumNewRecs
DataArray(J).Model = ActiveSheet.Cells(J + 1, "A"): DataArray(J).Region = ActiveSheet.Cells(J + 1, "B")
.
.
.
DataArray(J).T33 = ActiveSheet.Cells(J + 1, "AO"): DataArray(J).T34 = ActiveSheet.Cells(J + 1, "AP")
DataArray(J).T35 = ActiveSheet.Cells(J + 1, "AQ")
Next J
End If
' Write out array to Graphing worksheet where Thm2 = stored value above
Windows("YieldTable Graphing Tool - Excel 2010.xlsm").Activate
ActiveWorkbook.Sheets(FileNameArray(F, 2)).Activate
' -- Clear existing data:
K = 0
While ActiveSheet.Cells(K + 4, "A").Value <> ""
K = K + 1
Wend
NumOldRecs = K

ActiveWorkbook.Sheets(FileNameArray(F, 2)).Activate
If NumOldRecs > 0 Then
Sheets(FileNameArray(F, 2)).Range("A4:AQ" & 3 + NumOldRecs).ClearContents
End If
' -- Write out array data for the appropriate growth model:
WriteRow = 4
For I = 1 To NumNewRecs
If DataArray(I).Model = Thm2 Then
ActiveSheet.Cells(WriteRow, "A").Value = DataArray(I).Model: ActiveSheet.Cells(WriteRow, "B").Value = DataArray(I).Region
.
.
.
ActiveSheet.Cells(WriteRow, "AO").Value = DataArray(I).T33: ActiveSheet.Cells(WriteRow, "AP").Value = DataArray(I).T34
ActiveSheet.Cells(WriteRow, "AQ").Value = DataArray(I).T35
WriteRow = WriteRow + 1
End If
Next I
' Close file w/o saving
Windows(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Activate
ActiveWorkbook.Saved = True
Workbooks(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Close

Next F

'Application.ScreenUpdating = True

End Sub

And for the record, it's very irritating that the formatting of the above code is not preserved here when pasted in.

shg · Oct 13, 2011

And for the record, it's very irritating that the formatting of the above code is not preserved here when pasted in.

For the record, it would be if you used code tags. http://www.mrexcel.com/forum/misc.php?do=bbcode#code

Norie · Oct 13, 2011

The use of ActiveSheet, ActiveWorkbook should be avoided if possible.

If you explicitly reference the workbooks/worksheets/ranges then you can make sure the code is running on what it's supposed to do.

For example when you open a workbook create a reference to it.

Code:

Dim wbOpen As Workbook
 
... code
Set wbOpen = Workbooks.Open (Filename:="C:\Work_General\SilviSIMS Southern Yields\Formatted Yield Files for Graphing Spreadsheet\" & _
FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx")
....code

Now you can use wbOpen whenever you want to refer to this workbook, for example to close it.

Code:

wbOpen.Close False

(Off the record, there are code tags you can wrap your code in, some people have links to how to use it in there sigs.

)

sjc · Oct 13, 2011

Let's see if this works. If it does, thanks Norie.

Code:

Private Sub GetDataBttn_Click()
    Dim Response As VbMsgBoxResult
    Dim SpecN As String              ' Species
    Dim FileN As String              ' Name used in file name path
    Dim Thm2 As String               ' Theme 2 value to filter on in data file
    Dim DataArray() As YldRec
    Dim FileNameArray(1 To 6, 1 To 2) As String
    Dim F As Integer, I As Long, J As Long, K As Long
    Dim NumNewRecs As Long, NumOldRecs As Long, WriteRow As Long
    
    ' Make sure that each of the three combo boxes has a selection
    If SpecLstCmbBox.Value = "" Or PhysRegCmbBox.Value = "" Or ModelListCmbBox.Value = "" Then
        Response = MsgBox("Error: Not All Input Fields Specified", vbOKOnly, "Invalid Input Data")
        Exit Sub
    End If

    'Application.ScreenUpdating = False
    
    ' ChDir "G:\resource_planning\Planning\SouthernYields\SilviSims"
    If SpecLstCmbBox.Value = "Loblolly" Then
        SpecN = "Lob"
        Select Case PhysRegCmbBox.Value
            Case "Lower Atlantic Coastal Plain"
                FileN = "LACP_PUCP"
                Thm2 = "LACP_PMRC"
            Case "Piedmont and Upper Coastal Plain"
                If ModelListCmbBox.Value = "PMRC East Coast Planted Lob" Then
                    FileN = "LACP_PUCP"
                    Thm2 = "PUCP_PMRC"
                ElseIf ModelListCmbBox.Value = "VPI Planted Lob" Then
                    FileN = "LACP_PUCP"
                    Thm2 = "PUCP_PMRC"
                End If
            Case "West Gulf Coastal Plain"
                FileN = "WGCP_WGHCP"
                Thm2 = "WGCP_WG"
            Case "West Gulf Hilly Coastal Plain"
                If ModelListCmbBox.Value = "PMRC East Coast Planted Lob" Then
                    FileN = "WGCP_WGHCP"
                    Thm2 = "WGHCP_WG"
                ElseIf ModelListCmbBox.Value = "VPI Planted Lob" Then
                    FileN = "WGCP_WGHCP"
                    Thm2 = "WGHCP_VPI"
                End If
        End Select
    ElseIf SpecLstCmbBox.Value = "Slash" Then
        SpecN = "Sla"
        Select Case PhysRegCmbBox.Value
            Case "Lower Atlantic Coastal Plain"
                FileN = "LACP_PUCP"
                Thm2 = "LACP_PMRC"
            Case "Piedmont and Upper Coastal Plain"
                If ModelListCmbBox.Value = "PMRC East Coast Planted Slash" Then
                    FileN = "LACP_PUCP"
                    Thm2 = "PUCP_PMRC"
                ElseIf ModelListCmbBox.Value = "West Gulf Planted Slash" Then
                    FileN = "LACP_PUCP"
                    Thm2 = "PUCP_PMRC"
                End If
            Case "West Gulf Coastal Plain"
                FileN = "WGCP_WGHCP"
                Thm2 = "WGCP_WG"
            Case "West Gulf Hilly Coastal Plain"
                FileN = "WGCP_WGHCP"
                Thm2 = "WGHCP_WG"
        End Select
    
    End If
    
    ' Create File List:
    FileNameArray(1, 1) = "Graph_BA"
    FileNameArray(2, 1) = "Graph_Inv"
    FileNameArray(3, 1) = "Graph_Pulp"
    FileNameArray(4, 1) = "Graph_Saw"
    FileNameArray(5, 1) = "Graph_ThinVol"
    FileNameArray(6, 1) = "Graph_TPA"
    ' Create Destination Sheet List:
    FileNameArray(1, 2) = "BA"
    FileNameArray(2, 2) = "Inv"
    FileNameArray(3, 2) = "%Pulp"
    FileNameArray(4, 2) = "%Saw"
    FileNameArray(5, 2) = "ThinVol"
    FileNameArray(6, 2) = "TPA"
    
    For F = 1 To 6
    
        ' Open source data file if not already open:
        If Not BookE(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx") Then
            Workbooks.Open Filename:="C:\Work_General\SilviSIMS Southern Yields\Formatted Yield Files for Graphing Spreadsheet\" & _
                                      FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx"
        End If
        Windows(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Activate
        
        ' Figure out number of rows
        I = 0
        'While Workbooks(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Cells(Rw, 1).Value <> ""
        While ActiveSheet.Cells(I + 2, 1).Value <> ""
            I = I + 1
        Wend
        NumNewRecs = I
        
        ' ReDim array and store all data into array
        If I > 0 Then
            ReDim DataArray(1 To NumNewRecs) As YldRec
            For J = 1 To NumNewRecs
                DataArray(J).Model = ActiveSheet.Cells(J + 1, "A"):     DataArray(J).Region = ActiveSheet.Cells(J + 1, "B")
                    .
                    .
                    .
               DataArray(J).T33 = ActiveSheet.Cells(J + 1, "AO"):      DataArray(J).T34 = ActiveSheet.Cells(J + 1, "AP")
                DataArray(J).T35 = ActiveSheet.Cells(J + 1, "AQ")
            Next J
        End If
        ' Write out array to Graphing worksheet where Thm2 = stored value above
        Windows("YieldTable Graphing Tool - Excel 2010.xlsm").Activate
        ActiveWorkbook.Sheets(FileNameArray(F, 2)).Activate
        ' -- Clear existing data:
        K = 0
        While ActiveSheet.Cells(K + 4, "A").Value <> ""
            K = K + 1
        Wend
        NumOldRecs = K

        ActiveWorkbook.Sheets(FileNameArray(F, 2)).Activate
        If NumOldRecs > 0 Then
            Sheets(FileNameArray(F, 2)).Range("A4:AQ" & 3 + NumOldRecs).ClearContents
        End If
        ' -- Write out array data for the appropriate growth model:
        WriteRow = 4
        For I = 1 To NumNewRecs
            If DataArray(I).Model = Thm2 Then
                ActiveSheet.Cells(WriteRow, "A").Value = DataArray(I).Model:    ActiveSheet.Cells(WriteRow, "B").Value = DataArray(I).Region
                    .
                    .
                    .
                ActiveSheet.Cells(WriteRow, "AO").Value = DataArray(I).T33:     ActiveSheet.Cells(WriteRow, "AP").Value = DataArray(I).T34
                ActiveSheet.Cells(WriteRow, "AQ").Value = DataArray(I).T35
                WriteRow = WriteRow + 1
            End If
        Next I
        ' Close file w/o saving
        Windows(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Activate
        ActiveWorkbook.Saved = True
        Workbooks(FileNameArray(F, 1) & "_" & SpecN & "_" & FileN & ".xlsx").Close
        
    Next F
            
    'Application.ScreenUpdating = True

    
End Sub

sjc · Oct 13, 2011

Thanks, Norie. I can see where explicitly identifying the workbooks as Dim'd items will help. How about the Sheets in the workbooks though? It looks like I can create a variable called 'MySheet' for example and it can be of type 'Sheet1', or 'Sheet2', or 'Sheet3', etc. How do these differ and how do they affect how I reference MySheet? I haven't been having problems writing to the correct workbook, but I have been having problems getting the array data written out to the correct sheet.

Also, any thoughts on why it's so slow to write? In the past, I've dumped array data out and it has come out very quickly, as in many cells filled per second.

Norie · Oct 13, 2011

There are no object/data types called Sheet1, Sheet2 etc.

You'll probably want Sheet or more specifically Worksheet, Sheet includes other kinds of 'sheet' eg chart cheetahs.

If there is only one worksheet in the workbook you are opening that's easy.

Code:

Dim wsSrc As Worksheets
 
   Set wsSrc = wbOpen.Worksheets(1)

Now this is where I get confused, and it's partly because ActiveSheet has been used.

I just can't see what other worksheets/workbooks are involved.

I think there's a workbook called 'YieldTable Graphing Tool - Excel 2010.xlsm' involved.

If there is you can create a reference to it like this.

Code:

Dim wbGraphTool As Workbook
 
      Set wbGraphTool = Workbooks("YieldTable Graphing Tool - Excel 2010.xlsm")

Even easier, if that workbook is the one the code is in.

Code:

Dim wbGraphTool As Workbook
      
    Set wbGraphTool = ThisWorkbook

Now for the sheets, no sorry - thought I had something but no.

sjc · Oct 13, 2011

I think that does help. I'm going to make some modifications based on your advice and see if there's an effect. Will post back.

sjc · Oct 13, 2011

Well, the workbook and sheet references are much cleaner. It's still glacially slow writing out the array data though. It fills the array in about 6 seconds but still writes out a single value about once every 1-2 seconds. Doesn't matter if I write it to the same workbook or to a blank workbook. Anyone have any thoughts on why it would write the array contents so slowly?

ActiveSheet is not the ActiveSheet?

sjc

New Member

Excel Facts

Andrew Poulsom

MrExcel MVP

sjc

New Member

shg

MrExcel MVP

Norie

Well-known Member

sjc

New Member

sjc

New Member

Norie

Well-known Member

sjc

New Member

sjc

New Member

Similar threads

Forum statistics

Share this page

ActiveSheet is not the ActiveSheet?

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

Well-known Member

New Member

New Member

Well-known Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock