VB6 - subscript out of range on excel sheet

In my VB6 code, I am pulling up data from my 2012 SQL database.  Then I would input the code into an excel sheet as you see from the code below.  Everything was going well until I received an error.  I have an error on line 140 The problem is when I try to input data into the excel sheet called Organizing.  It works fine when transpose the data into the Cover Sheet.   However,  I get the error, subscript out of range when it tries to transpose into the Organizing page.  I can't seem to figure out why that line specifically has that error.  Can anyone see my issue?


Private Sub Command4_Click()



Set conn = New ADODB.Connection
Set rec = New ADODB.Recordset
Set rec1 = New ADODB.Recordset
conn.Open "Provider=sqloledb;Data Source=" & ConnectionIP & ",xxx;Network Library=DBMSSOCN;Initial Catalog= " & CAPDB & "; User ID=xx;Password=xxx"



esql = ";With CTE_Hours as(select distinct  RegID from tblOrgHours h inner join tblOrgActivities A on H.ActivityID = A.ActivityID Where [Hours] > 0 And h.Agency = 'Administrator' And H.Fiscal = 2018 And H.ActivityDate >= '20170701' And H.ActivityDate < '20180101')" & _
       "select Count(DISTINCT CASE when R.Race = 'Asian' then h.regid else null end) as [Asian],Count(DISTINCT CASE when R.Race = 'African-American' then h.regid else null end) as [African-American] ,Count(DISTINCT CASE when R.Race = 'Caucasian' then h.regid else null end) as [Caucasian] ,Count(DISTINCT CASE when R.Race = 'Native-American' then h.regid else null end) as [Native-American] ,Count(DISTINCT CASE when R.Race = 'Multi-Racial' then h.regid else null end) as [Multi-Racial]" & _
       ",Count(DISTINCT CASE when R.Race = 'Latino-Hispanic' then h.regid else null end) as [Latino-Hispanic] ,Count(DISTINCT CASE when R.AgeCurrent >= 11 and R.AgeCurrent <= 13 then h.regid else null end) as [Ages 11-13],Count(DISTINCT CASE when R.AgeCurrent >= 14 and R.AgeCurrent <= 18 then h.regid else null end) as [Ages 14-18] ,Count(DISTINCT CASE when R.AgeCurrent >= 19 and R.AgeCurrent <= 24 then h.regid else null end) as [Ages 19-24] ,Count(DISTINCT CASE when R.AgeCurrent >= 25 and R.AgeCurrent <= 65 then h.regid else null end) as [Ages 25-65]" & _
       ",Count(DISTINCT CASE when R.AgeCurrent >= 66 then h.regid else null end) as [Ages 65+],Count(distinct CASE when R.Gender = 'Male' then h.regid else null end) as [Male]" & _
       ",Count(distinct CASE when R.Gender = 'Female' then h.regid else null end) as [Female] from CTE_Hours H inner join tblOrgRegistrations R on H.Regid = R.RegID where R.AgeCurrent between 11 and 999"
 
 If rec.State = adStateOpen Then
        rec.Close
End If

      rec.CursorType = adOpenStatic
      rec.CursorLocation = adUseClient
      rec.LockType = adLockOptimistic
      rec.Open esql, conn, , , adCmdText

        
        
    rec.MoveFirst
    
    
    
'Dumping into Cover Page-----------------------------------------------------------------------------------

Set rec1 = New ADODB.Recordset
esql1 = "select GetDate()"
                rec1.Open (esql1), conn, adOpenStatic, adLockReadOnly
                ServerTime = rec1.Fields(0)
                rec1.Close
                
                

    
    
'On Error GoTo CheckError1

   
Set ApExcel = CreateObject("Excel.application") 'Creates an object
ApExcel.Visible = True ' So you can see Excel


'On Error GoTo CheckError2


ApExcel.Workbooks.Open "http://www.xxxxx.org/CYSReport.xls"


    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(1, 1).Formula = Combo12.Text
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(33, 2).Formula = rec![Asian]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(34, 2).Formula = rec![African-American]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(35, 2).Formula = rec![Native-American]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(36, 2).Formula = rec![Caucasian]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(37, 2).Formula = rec![Multi-Racial]
    
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(40, 2).Formula = rec![Latino-Hispanic]
    
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(42, 2).Formula = rec![Ages 11-13]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(43, 2).Formula = rec![Ages 14-18]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(44, 2).Formula = rec![Ages 19-24]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(45, 2).Formula = rec![Ages 25-65]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(46, 2).Formula = rec![Ages 65+]
    
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(49, 2).Formula = rec![Female]
    ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Cells(50, 2).Formula = rec![Male]
'--------------------------------



'Organizing---------------------------------------------------------------------------


esql = ";With CTE_Hours as (select distinct AgencyID, Agency,Classification,Objectives, Deliverables, Advocate, AdvocacyType, ActivityID, RegID, cast(ActivityDate as Date) ActivityDate, Fiscal From tblOrgHours Where [Hours] > 0) select H.Agency,A.ActivityName,H.Classification,H.ActivityDate,H.Objectives,H.Deliverables,H.Advocate,H.AdvocacyType,Count(H.RegID) as [# individuals]" & _
       ",SUM(CASE when R.AgeCurrent >= 11 and R.AgeCurrent <= 13 then 1 else 0 end) as [Ages 11-13]" & _
       ",SUM(CASE when R.AgeCurrent >= 14 and R.AgeCurrent <= 18 then 1 else 0 end) as [Ages 14-18]" & _
       ",SUM(CASE when R.AgeCurrent >= 19 and R.AgeCurrent <= 24 then 1 else 0 end) as [Ages 19-24]" & _
       ",SUM(CASE when R.AgeCurrent >= 25 and R.AgeCurrent <= 65 then 1 else 0 end) as [Ages 25-65]" & _
       ",SUM(CASE when R.AgeCurrent >= 66 then 1 else 0 end) as [Ages 65+]" & _
       ",SUM(CASE when R.Board = 1 then 1 else 0 end) as [CommunityCommittee],SUM(CASE when R.YouthCommittee = 1 then 1 else 0 end) as [YouthCommittee],SUM(CASE when R.Parentcheck = 1 then 1 else 0 end) as [Parentcheck],SUM(CASE when R.CommunityResident = 1 then 1 else 0 end) as [CommunityResident]" & _
       ",SUM(CASE when R.Race = 'Asian' then 1 else 0 end) as [Asian]" & _
       ",SUM(CASE when R.Race = 'African-American' then 1 else 0 end) as [African-American]" & _
       ",SUM(CASE when R.Race = 'Caucasian' then 1 else 0 end) as [Caucasian]" & _
       ",SUM(CASE when R.Race = 'Native-American' then 1 else 0 end) as [Native-American]" & _
       ",SUM(CASE when R.Race = 'Multi-Racial' then 1 else 0 end) as [Multi-Racial]" & _
       ",SUM(CASE when R.Race = 'Latino-Hispanic' then 1 else 0 end) as [Latino-Hispanic]" & _
       ",SUM(CASE when R.Gender = 'Male' then 1 else 0 end) as [Male]" & _
       ",SUM(CASE when R.Gender = 'Female' then 1 else 0 end) as [Female]" & _
       ",SUM(CASE when R.Sector = 'Business' then 1 else 0 end) as [Business]" & _
       ",SUM(CASE when R.Sector = 'Civic-Volunteer' then 1 else 0 end) as [Civic-Volunteer]" & _
       ",SUM(CASE when R.Sector = 'Community Resident' then 1 else 0 end) as [Community Resident]" & _
       ",SUM(CASE when R.Sector = 'Faith Based' then 1 else 0 end) as [Faith Based]" & _
       ",SUM(CASE when R.Sector = 'Healthcare' then 1 else 0 end) as [Healthcare]" & _
       ",SUM(CASE when R.Sector = 'Human Support Agencies' then 1 else 0 end) as [Human Support Agencies]" & _
       ",SUM(CASE when R.Sector = 'Law Enforcement' then 1 else 0 end) as [Law Enforcement]" & _
       ",SUM(CASE when R.Sector = 'Local Government' then 1 else 0 end) as [Local Government]" & _
       ",SUM(CASE when R.Sector = 'Media' then 1 else 0 end) as [Media],SUM(CASE when R.Sector = 'Parent or Guardian' then 1 else 0 end) as [Parent or Guardian],SUM(CASE when R.Sector = 'Philanthropic' then 1 else 0 end) as [Philanthropic],SUM(CASE when R.Sector = 'Schools' then 1 else 0 end) as [Schools],SUM(CASE when R.Sector = 'Youth' then 1 else 0 end) as [Youth] from CTE_Hours H inner join tblOrgRegistrations R on H.Regid = R.RegID inner join tblOrgActivities A on H.ActivityID = A.ActivityID where R.AgeCurrent between 11 and 999 And h.Agency = '" & Combo12.Text & "' And H.Fiscal = 2018 And H.ActivityDate >= '" & DTPicker1 & "' And H.ActivityDate < '" & DTPicker2 & "' group by H.Agency, H.Classification,A.ActivityName,H.ActivityDate, H.Objectives, H.Deliverables, H.Advocate, H.AdvocacyType Order by H.Agency, H.Classification,H.ActivityDate,A.ActivityName"


 
 'If rec.State = adStateOpen Then
        rec.Close
'End If

      rec.CursorType = adOpenStatic
      rec.CursorLocation = adUseClient
      rec.LockType = adLockOptimistic
      rec.Open esql, conn, , , adCmdText




        
    rec.MoveFirst



'Dumping into Organizing Page-----------------------------------------------------------------------------------

                
                
j = 5
 
Do Until rec.EOF

    j = j + 1
        
                 

                
                
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 1).Formula = rec![Agency]
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 2).Formula = rec![ActivityName]
                
                For i = 26 To 39
                    If rec.Fields(i) > 0 Then
                        SectorString = SectorString + "1,"
                    End If
                    
                Next i
                    
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 3).Formula = SectorString
                



Exit Sub




rec.MoveNext

Loop
                    
 
  






 
End Sub

Open in new window

CYSReport.xls
al4629740Asked:
Who is Participating?
 
Martin LissOlder than dirtCommented:
I see the problem. In the workbook the name of the worksheet is "Organizing "; it has a space at the end.
0
 
Martin LissOlder than dirtCommented:
Is CYSReport.xls open when you execute that code?
0
 
al4629740Author Commented:
yes.

it seems like it needs to have the Organizing tab open
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
al4629740Author Commented:
it initially opens the doc up just fine
0
 
al4629740Author Commented:
The first sheet "Cover Page" works fine.  The error happens if I try to transpose data into the other sheet.
0
 
Martin LissOlder than dirtCommented:
Try adding

ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Activate

before you do that.
0
 
al4629740Author Commented:
same problem

j = 5
 
Do Until rec.EOF

    j = j + 1
        
                 

                ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Activate
                
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 1).Formula = rec![Agency]
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 2).Formula = rec![ActivityName]
                
                For i = 26 To 39
                    If rec.Fields(i) > 0 Then
                        SectorString = SectorString + "1,"
                    End If
                    
                Next i
                    
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 3).Formula = SectorString

Open in new window

0
 
al4629740Author Commented:
oh wait  wrong page
0
 
al4629740Author Commented:
Problem is now on line 9

same error


j = 5
 
Do Until rec.EOF

    j = j + 1
        
                 

                ApExcel.Workbooks("CYSReport.xls").Sheets("Cover Page").Activate
                
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 1).Formula = rec![Agency]
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 2).Formula = rec![ActivityName]
                
                For i = 26 To 39
                    If rec.Fields(i) > 0 Then
                        SectorString = SectorString + "1,"
                    End If
                    
                Next i
                    
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 3).Formula = SectorString

Open in new window

0
 
Martin LissOlder than dirtCommented:
Line 9 refers to "Cover Page", is that correct?
0
 
al4629740Author Commented:
no I corrected it and ran it.  Same problem.  I just forgot to recopy

In this one below, error on line 7

Do Until rec.EOF

    j = j + 1
        
                 

                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Activate
                
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 1).Formula = rec![Agency]
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 2).Formula = rec![ActivityName]
                
                For i = 26 To 39
                    If rec.Fields(i) > 0 Then
                        SectorString = SectorString + "1,"
                    End If
                    
                Next i
                    
                ApExcel.Workbooks("CYSReport.xls").Sheets("Organizing").Cells(j, 3).Formula = SectorString
                



Exit Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Just for fun, add this before your current line 1.

ApExcel.Workbooks.Open "http://www.xxxxx.org/CYSReport.xls"
0
 
NorieVBA ExpertCommented:
Have you checked all the workbook and worksheet names?

Check for things like leading/trailing space, spelling mistakes etc.

By the way, it might be an idea to create a reference to the workbook when you open it.

For example, something like this.
Set ApExcel = CreateObject("Excel.application") 'Creates an object
ApExcel.Visible = True ' So you can see Excel


'On Error GoTo CheckError2


Set wbReport = ApExcel.Workbooks.Open( "http://www.xxxxx.org/CYSReport.xls")

Open in new window

Once you have the reference you can use it throughout the code.
With wbReport
    .Sheets("Cover Page").Cells(1, 1).Formula = Combo12.Text
    .Sheets("Cover Page").Cells(33, 2).Formula = rec![Asian]
    .Sheets("Cover Page").Cells(34, 2).Formula = rec![African-American]
    .Sheets("Cover Page").Cells(35, 2).Formula = rec![Native-American]
    .Sheets("Cover Page").Cells(36, 2).Formula = rec![Caucasian]
    .Sheets("Cover Page").Cells(37, 2).Formula = rec![Multi-Racial]
End With

Open in new window


PS You could also create references to the worksheets.
0
 
al4629740Author Commented:
Excel says document open would you like to open another.  

incidentally, when I click yes, it still gives an error because the default page that opens is the cover page
0
 
al4629740Author Commented:
I just tried the suggestion and had the same problem.
0
 
al4629740Author Commented:
Let me try that spacing.  One sec
0
 
al4629740Author Commented:
YOU ARE THE MAN!
0
 
Martin LissOlder than dirtCommented:
Thanks,  I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.