unable to load data into different tabs in Excel 2013 using VB6 - excel

Question

In my organization we have one old project/application which was build on Visual Basic 6.0
In that application we have export to Excel "button" where data gets populated into different tabs in spreadsheet with click. It was working very well with Excel 2010 and later until we moved to EXCEL 2013.
Issue: We need data to get exported into 2 tabs in excel 2013 whereas its coming in 1 tab only. I tried using package and deployment wizard and all possible help available. So far no luck. Please let me know if you have any questions or if I am not enough clear. Please find below my code.
Dim uprev As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlsheet2 As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean ' Flag for final release.
Dim n As Integer
Dim n1 As Integer
Dim n2 As Integer
Dim i As Integer
Dim lastrevdate As String
Dim lastrevrow As Integer
Dim lastrow As Integer
Dim previouspcno As Integer
Dim xlcol As String
Dim j As Integer
Dim k As Integer
Dim dc As Adodc
Dim mrc As Recordset
Dim qpa As New QPArray
Dim Found As Long
Dim StartInd As Long
Dim bFound As Boolean
Dim crlf As String
On Error GoTo errorhandler1
crlf = Chr(13) & Chr(10)
ReDim qs(10) As String
ReDim q(10) As Integer
ReDim hdr(15) As Integer
ReDim rev(10, 0) As String
ReDim part(0) As String
ReDim sl(nof) As String
ReDim cmpsql2(0) As String
ReDim deletedfromsql(3, 0) As String
Dim doThis As Integer
Dim iReturn As Integer
Dim revlev As String
Dim Date_Engr As String
Dim Date_Checker As String
'On Error Resume Next ' Defer error trapping.
'Removed, not checking to see if excel is open properly
'Bert - 6/5/07
'Set xlApp = GetObject(, "Excel.Application")
'If Err.Number <> 0 Then
' ExcelWasNotRunning = True
'Else
' MsgBox ("Please Close Excel before continuing")
' Exit Sub
'End If
Err.Clear ' Clear Err object in case error occurred.
iReturn = MsgBox("Please Close ALL Excel applications before continuing", vbOKOnly, "WARNING")
ExcelWasNotRunning = True
'fixwidth
Screen.MousePointer = vbHourglass
'DetectExcel
Set xlApp = Excel.Application
'path(8) = "C:\SwitchGear\Files1\eng_prod\Jobs\cs01157\medt\"
If Dir(Defaults.medt & "\" & cs & sos & "mbom.xls", vbNormal) <> "" Then
mbomflag = 1
FileCopy Defaults.medt & "\" & cs & sos & "mbom.xls", Defaults.medt & "\" & cs & sos & "mbom.bak"
Set xlBook = GetObject(Defaults.medt & "\" & cs & sos & "mbom.xls")
Set xlSheet = xlBook.Worksheets(1)
Set xlsheet2 = xlBook.Worksheets(2)
Do
qs(1) = "1. Do not list changes on rev sheet" & crlf
qs(1) = qs(1) & "2. list changes on rev sheet but do not increase rev level" & crlf
qs(1) = qs(1) & "3. list changes on rev sheet and increase rev level"
qs(0) = InputBox(qs(1))
If qs(0) = "" Then Exit Sub
Loop Until qs(0) > "0" And qs(0) < "4"
If qs(0) = "3" Then ' up the revision
uprev = 2
revlev = xlsheet2.Cells(5, 3) + 1
Date_Engr = Date
Date_Checker = Date
Else
uprev = 1
revlev = xlsheet2.Cells(5, 3)
Date_Engr = xlSheet.Cells(16, 2) ' get the old rev number
Date_Checker = xlSheet.Cells(16, 3)
End If
lastrow = xlSheet.Cells.Range("E20").End(xlDown).Row
ReDim cmpxl2(0) As String
ReDim cmpxl3(0) As String
ReDim cmpxl4(0) As String
n = 0
For i = 20 To lastrow
If xlSheet.Cells(i, 2) <> "" Then
n = n + 1
ReDim Preserve cmpxl2(n) As String
ReDim Preserve cmpxl3(n) As String
ReDim Preserve cmpxl4(n) As String
cmpxl2(n) = xlSheet.Cells(i, 2) & " " & Format(i)
cmpxl3(n) = xlSheet.Cells(i, 3)
cmpxl4(n) = xlSheet.Cells(i, 4)
End If
Next i
n1records = Adodc1.Recordset.RecordCount
'If n > n1records Then 'it's been deleted from sql so find the part and add to xl revision sheet
n1 = 0
ReDim cmpsql2(n1records) As String
With Adodc1.Recordset
For i = 1 To n1records
If i = 1 Then
Adodc1.Recordset.MoveFirst
Else
Adodc1.Recordset.MoveNext
End If
cmpsql2(i) = !pcno
Next i
End With
For i = 1 To n
bFound = qpa.Find(cmpsql2(), Left$(cmpxl2(i), 4), Found, , 1)
If bFound = False Then
q(1) = Val(Mid$(cmpxl2(i), 6))
n1 = n1 + 1
ReDim Preserve deletedfromsql(3, n1)
deletedfromsql(1, n1) = xlSheet.Cells(q(1), 2)
deletedfromsql(2, n1) = xlSheet.Cells(q(1), 3)
deletedfromsql(3, n1) = xlSheet.Cells(q(1), 4)
End If
Next i
'End If
n = 0
Do
n = n + 1
If xlsheet2.Cells(n + 13, 1) > " " Then
ReDim Preserve rev(10, n)
ReDim Preserve part(n)
'part(n) = xlSheet.Cells(n + 13, 3) & "*" & xlSheet.Cells(n + 13, 1)
If xlsheet2.Cells(n + 13, > CDate(lastrevdate) Then
lastrevdate = xlsheet2.Cells(n + 13, 8-)
End If
For i = 1 To 10
rev(i, n) = xlsheet2.Cells(n + 13, i)
Next i
Else
Exit Do
End If
Loop
If engr = "" Then
engr = xlSheet.Cells(14, 2)
chcked = xlSheet.Cells(14, 3)
End If
Else
mbomflag = 0
revlev = 0
If engr = "" Then
engr = UCase$(InputBox("Enter Mechanical drafter's Initials:", "Enter Initials"))
'If engr = "" Then Exit Sub
chcked = UCase$(InputBox("Enter Checker's Initials:", "Enter Initials"))
'If chcked = "" Then Exit Sub
End If
End If
'Set xlBook = GetObject(path(2) & "vb\sql\ebomtemplate.xls")
Set xlBook = GetObject(Defaults.ApplicationPath & "\mbomTemplate.xls")
Set xlSheet = xlBook.Worksheets(1)
Set xlsheet2 = xlBook.Worksheets(2)
If revlev = 0 Then
xlsheet2.Cells(14, 8= Date
End If
'xlSheet.PageSetup.Zoom = 50
If UBound(rev, 2) > 0 Then
lastrevrow = UBound(rev, 2) + 13
For i = 14 To UBound(rev, 2) + 13
For j = 1 To 10
xlsheet2.Cells(i, j) = rev(j, i - 13)
Next j
Next i
Else
lastrevrow = 13
End If
'If uprev = 1 Then
' xlBook.Application.Visible = True
' xlBook.Parent.Windows(2).Visible = True
' xlBook.Parent.Windows(2).Activate
' xlSheet.Activate
'bFound = bringwindowtotop(hwnd)
'xlBook.Sheets(1).Select
'ActiveSheet.Visible = True
'xlBook.Application.DoubleClick
'Else
xlBook.Application.Visible = True
xlBook.Parent.Windows(1).Visible = True
xlBook.Parent.Windows(1).Activate
xlSheet.Activate
'DetectExcel
'bFound = bringwindowtotop(hwnd)
'End If
'DetectVB
'Found = apiShowWindow(hwnd, SW_SHOWMINIMIZED)
'DetectExcel
'Found = apiShowWindow(hwnd, SW_SHOWMAXIMIZED)
Me.Visible = False
Screen.MousePointer = vbDefault
'If uprev = 1 Then
' xlBook.NewWindow.Activate
' With xlBook.NewWindow
' .ActiveSheet = 2
' .Zoom = 50
' End With
'End If
'xlBook.Application.Visible = True
'xlBook.Parent.Windows(1).Visible = True
'xlSheet.Activate
'qs(1) = "03040609121314151617181920212223242526272829303132333435"
cs = UCase$(cs)
sos = UCase$(sos)
xlSheet.Cells(10, 2) = cs & Left$(sos, 5)
If Val(framestr(0, 0, 15)) < 8 Then qs(1) = "2" Else qs(1) = "4"
xlSheet.Cells(10, 3) = "-" & Mid$(sos, 6, 1) & Right$(sos, 1) & "B" & qs(1) & "004"
xlSheet.Cells(12, 2) = Right$(sos, 3)
xlSheet.Cells(10, 6) = framestr(0, 0, 3)
'xlSheet.Cells(12, 3) = "0"
'xlSheet.Cells(16, 2) = Date
'xlSheet.Cells(16, 3) = Date
xlSheet.Cells(10, 4) = framestr(0, 0, 658) 'sold to
xlSheet.Cells(11, 4) = framestr(0, 0, 657)
xlSheet.Cells(12, 4) = framestr(0, 0, 656)
xlSheet.Cells(14, 2) = engr
xlSheet.Cells(14, 3) = chcked
xlSheet.Cells(14, 4) = framestr(0, 0, 655) 'for
xlSheet.Cells(14, 6) = framestr(0, 0, 661) 'purchase order
xlSheet.Cells(15, 4) = framestr(0, 0, 654)
xlSheet.Cells(16, 4) = framestr(0, 0, 653)
xlcol = "L M N O P Q R S T U V W X Y Z AAABACADAEAFAGAHAIAJ"
qs(1) = "L12:" & Trim$(Mid$(xlcol, (nof + 1) * 2 - 1, 2)) & "16"
xlSheet.Cells.Range(qs(1)).Value = " "
For i = 1 To nof
xlSheet.Cells(19, i + 11) = i
Next i
For i = 1 To nof + 1
qs(1) = Trim$(Mid$(xlcol, i * 2 - 1, 2)) & "12:" & Trim$(Mid$(xlcol, i * 2 - 1, 2)) & "16"
With xlSheet.Cells.Range(qs(1)).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Next i
qs(1) = Chr(76) & "12:" & Trim$(Mid$(xlcol, nof * 2 - 1, 2)) & "12"
With xlSheet.Cells.Range(qs(1)).Borders(xlTop)
'.LineStyle = xlContinuous
.Weight = xlMedium
End With
qs(1) = Chr(76) & "16:" & Trim$(Mid$(xlcol, nof * 2 - 1, 2)) & "16"
With xlSheet.Cells.Range(qs(1)).Borders(xlBottom)
'.LineStyle = xlContinuous
.Weight
I am aware VB 6 is outdated and not sure why they don't move to VB.NET. I would really appreciate if anyone can help. Thanks in advance :)

Answer 1

Your problem is nothing to do with VB6 being outdated. The problem is that this code is unrunnable. I can only make a guess that this is some hacked version based on the real running code. I will make some guesses based on approximately what this code should really look like. However, it would be a good idea to provide the actual code.
By "tabs", I take it you mean "worksheets". I am guessing that they are called "Sheet1" and "Sheet2". So basically, only "Sheet1" is actually getting re-populated. "Sheet2" remains as it previously looked.
I would suggest that you put a breakpoint on the line:
Set xlsheet2 = xlBook.Worksheets(2)
See whether xlsheet2.Cells(14,8) evaluates to the date you expect to see on that worksheet.
After stepping through this line, ensure that xlsheet2 actually points to the worksheet you expect it to. I would also put breakpoints on every line which reads or writes xlsheet2.Cells(x,y) evaluate it, and look at sheet2, ensuring that the value read or written back is correct.