when i am generating sheet that time data has been corrupt and 1 sheet is correct and other sheet corrupt

[saurabhrahulsharma]

Hello Friends,
I am new in VBA and i want to develope one macro in which user will enter data and generate querry but when i am generating excel sheet that time one sheet is giving correct data but all other sheet has been corrupt automatically
the code is given below.

Sheet1----
Option Explicit
Dim con As New ADODB.Connection
Dim res As New ADODB.Recordset
Dim res1 As New ADODB.Recordset
Dim res2 As New ADODB.Recordset
Dim res3 As New ADODB.Recordset
Dim res4 As New ADODB.Recordset
Dim res5 As New ADODB.Recordset
Dim res6 As New ADODB.Recordset
Dim res7 As New ADODB.Recordset
Dim res8 As New ADODB.Recordset
Dim res9 As New ADODB.Recordset
Dim res10 As New ADODB.Recordset
Dim res11 As New ADODB.Recordset
Dim res12 As New ADODB.Recordset
Dim res13 As New ADODB.Recordset
Dim res14 As New ADODB.Recordset
Dim res15 As New ADODB.Recordset
Dim res16 As New ADODB.Recordset
Dim res17 As New ADODB.Recordset
Dim Filename, mDirName, metal, fnd, CFP, DsgStr As String
Dim sql, sql1, sql2, sql3, sql4, sql5, sql6, sql7, sql8, sql9, sql10, sql11, sql12, sql13, sql14, sql15, sql16, sql17 As String
Dim x, y, z, z1, z2, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, tmp, DiaQty, count, t, tmp1, p, count1, count2 As Integer
Dim shp As Object
Public Sub clear()
Sheet2.Name = "Sheet2"
For Each shp In Sheet2.Shapes
If shp.Name <> "Picture2" Then shp.Delete
Next
Sheet3.Range("A:I").ClearContents
Sheet2.Range("D39:D48").ClearContents
Sheet2.Range("E39:E48").ClearContents
Sheet2.Range("F39:F48").ClearContents
Sheet2.Range("G39:G48").ClearContents
Sheet2.Range("H39:H48").ClearContents
Sheet2.Range("I39:I48").ClearContents
Sheet2.Range("J39:J48").ClearContents
Sheet2.Range("K39:K48").ClearContents
Sheet2.Range("E49").ClearContents
End Sub
Public Sub transfer()
On Error GoTo errhandler
With con
.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=usrread;Initial Catalog=Emr;Data Source=MWKPDB;"
.CommandTimeout = 0
.Open
End With
mDirName = ThisWorkbook.Path & "\" & CStr(Sheet1.Range("A2").Text) + CStr(Sheet1.Range("b2").Text) + CStr(Sheet1.Range("c2").Text) + CStr(Sheet1.Range("d2").Text)
Call clear
If Dir(mDirName, vbDirectory) = "" Then
MkDir mDirName
End If
DsgStr = ""
If Sheet1.Range("A2").Text = "QS" Then
DsgStr = "SM"
Else
DsgStr = "DM"
End If
sql = "select omtc,omyy,omchr,omno,odsr,omdt,omcmcd,oddmcd,Omlmgsal,omlmssal,oddmcd,dmctg,pdesc from ordmst inner join orddsg on omtc=odtc and omyy=odyy and omchr=odchr and omno=odno inner join dsgmst on dmcd=oddmcd and dmtctyp='" & DsgStr & "' " & _
" inner join param on pmcd=dmctg and ptyp='dmctg' where omtc='" & Sheet1.Range("A2").Text & "' and omyy='" & Sheet1.Range("b2").Text & "' and omchr='" & Sheet1.Range("c2").Text & "' and omno='" & Sheet1.Range("d2").Text & "' "
res.CursorLocation = adUseClient
res.Open sql, con
Application.ScreenUpdating = False
If res.RecordCount = 0 Then
MsgBox "No Record Found"
con.Close
Set con = Nothing
Exit Sub
Else
For x = 0 To res.RecordCount - 1
Sheet2.Range("D30").Value = res.Fields.Item(7)
Sheet2.Range("D19").Value = res.Fields.Item(12)
InsertPictureInRange "\\mwkpdb\mwpict\" & res.Fields.Item(11) & "\dm 3d " & res.Fields.Item(7) & ".jpg", Sheet2.Range("G11:K11")

Sheet2.Visible = xlSheetVisible
Sheet2.Range("D8").Value = "K P SANGHVI INTL."
Sheet2.Range("F8").Value = "2004554"
Sheet2.Range("D20").Value = "India"
' Sheet2.Range("D41").Value = "India"
' Sheet2.Range("E41").Value = "India"
' Sheet2.Range("F41").Value = "India"
' Sheet2.Range("G41").Value = "India"
Sheet2.Range("D21").Value = "45 days"
Sheet2.Range("G56").Value = "NA"
Sheet2.Range("D41:K41").Value = "India"
Sheet2.Range("G57").Value = "NA"
Sheet2.Range("G58").Value = "NA"
Sheet2.Range("G59").Value = "NA"
Sheet2.Range("G60").Value = "NA"
Sheet2.Range("J56").Value = "NA"
Sheet2.Range("J57").Value = "NA"
Sheet2.Range("J58").Value = "NA"
Sheet2.Range("J59").Value = "NA"
Sheet2.Range("J60").Value = "NA"
Sheet2.Range("D60").Value = "NA"
Sheet2.Range("D59").Value = "NA"
Sheet2.Range("D58").Value = "NA"
Sheet2.Range("D57").Value = "NA"
Sheet2.Range("D64").Value = "NA"
Sheet2.Range("D65").Value = "NA"
Sheet2.Range("D56").Value = "NA"
Sheet2.Range("D62").Value = "0.00"
Sheet2.Range("G63").Value = "0.00"
Sheet2.Range("D54").Value = "Polished"

'sql2 = "select ortc,oryy,orsr,orno,(CASE WHEN RMCOL='W' THEN 'WHITE DIAMOND'WHEN RMCOL='-' THEN 'COLOUR DIAMOND' WHEN RMCOL='BL' THEN 'BLACK DIAMOND' WHEN RMCOL='BLE' THEN 'BLUE DIAMOND'WHEN RMCOL='BN' THEN 'BROWN NATTS DIAMOND'WHEN RMCOL='BR' THEN 'BROWN DIAMOND' WHEN RMCOL='WN' THEN 'WHITE NATTS DIAMOND'WHEN RMCOL='Y' THEN 'YELLOW DIAMOND' Else '' END)as 'Stone Color Name' from rmmst inner join ordrm on orrmcd=rmcd and orrmctg=rmctg and orrmsctg=rmsctg where oryy='" & Sheet1.Range("b2").Text & "' and orchr='" & Sheet1.Range("c2").Text & "' and orno='" & Sheet1.Range("d2").Text & "' and ortc='" & Sheet1.Range("A2").Text & "' and orrmctg in ('D','C') and orsr=" & res.Fields.Item(4) & ""
sql2 = "SELECT ORTC,ORYY,ORCHR,ORNO,ORSR,OMDT,ORRMCTG,ORRMSCTG,RMDESC,ORRMCD,RMCOL,ORWT,DMCTG,ORLN1,RMINTQLY,(CASE WHEN RMCOL='W' THEN 'WHITE DIAMOND'WHEN RMCOL='-' THEN 'COLOUR DIAMOND'WHEN RMCOL='BL' THEN 'BLACK DIAMOND'WHEN RMCOL='BLE' THEN 'BLUE DIAMOND'WHEN RMCOL='BN' THEN 'BROWN NATTS DIAMOND'WHEN RMCOL='BR' THEN 'BROWN DIAMOND'WHEN RMCOL='WN' THEN 'WHITE NATTS DIAMOND'WHEN RMCOL='Y' THEN 'YELLOW DIAMOND' Else '' END)as 'Stone Color Name' FROM ORDRM JOIN ORDMST ON ORTC=OMTC AND ORYY=OMYY AND ORCHR=OMCHR AND ORNO=OMNO JOIN RMMST ON ORRMCD=RMCD AND ORRMCTG=RMCTG AND ORRMSCTG=RMSCTG JOIN ORDDSG ON ORTC=ODTC AND ORYY=ODYY AND ORCHR=ODCHR AND ORNO=ODNO AND ORSR=ODSR JOIN DSGMST ON ODDMCD=DMCD WHERE ORTC='" & Sheet1.Range("A2").Text & "' AND ORYY='" & Sheet1.Range("b2").Text & "' AND ORCHR='" & Sheet1.Range("c2").Text & "' AND ORNO='" & Sheet1.Range("d2").Text & "' AND ORSR=" & res.Fields.Item(4) & " AND ORRMCTG IN ('C','D')"
res2.CursorLocation = adUseClient
res2.Open sql2, con

If res2.RecordCount = 0 Then
res2.Close
Set res2 = Nothing
Else
For y = 0 To res2.RecordCount - 1
'Sheet2.Range("M46").Value = res2.Fields.Item(15)
Sheet3.Range("A" & 1 + y).Value = res2.Fields.Item(15)
' Sheet2.Range("M50").Value = res2.Fields.Item(13)
'Sheet2.Range("J66").Value = res2.Fields.Item(16)
res2.MoveNext
Next
End If
Sheet3.coltorow
If res2.EOF Then res2.Close
sql3 = "SELECT OMTC,OMYY,OMNO,ODSR,OMCMCD,OMLMGCST,ODSALPRC,ORRMCTG,(CASE WHEN ORRMCTG NOT IN ('D','C') THEN SUM(ORSALVAL) ELSE 0 END) AS 'METAL',(CASE WHEN ORRMCTG IN ('D','C') THEN SUM(ORSETSALVAL) ELSE 0 END) AS 'SETTING' FROM ORDMST INNER JOIN ORDDSG " & _
"ON OMTC=ODTC AND OMYY=ODYY AND OMCHR=ODCHR AND OMNO=ODNO " & _
"INNER JOIN ORDRM ON ODTC=ORTC AND ODYY=ORYY AND ODCHR=ORCHR AND ODNO=ORNO AND ODSR=ORSR " & _
"where omtc='" & Sheet1.Range("A2").Text & "' and omyy='" & Sheet1.Range("b2").Text & "' and omchr='" & Sheet1.Range("c2").Text & "' " & _
"and omno='" & Sheet1.Range("d2").Text & "' AND ODSR=" & res.Fields.Item(4) & " " & _
"GROUP BY OMTC,OMYY,OMNO,ODSR,OMCMCD,OMLMGCST,ODSALPRC,ORRMCTG"

res3.CursorLocation = adUseClient
res3.Open sql3, con
If res3.RecordCount = 0 Then
res3.Close
Set res3 = Nothing
Else
For z = 0 To res3.RecordCount - 1
If res3.Fields.Item(7).Value = "D" Then
Sheet2.Range("J62").Value = res3.Fields.Item(9)
End If
If res3.Fields(7).Value = "G" Then
Sheet2.Range("G64").Value = res3.Fields.Item(8)
End If
res3.MoveNext
Next
End If
If res3.EOF Then res3.Close
sql4 = "SELECT OLTC,OLYY,OLNO,OLSR,OLSRNO,OLMCD,OLQW,SUM(OLSALVAL),odsalprc FROM ORDLAB " & _
"INNER JOIN ORDDSG ON OLTC=ODTC AND OLYY=ODYY AND OLCHR=ODCHR AND OLNO=ODNO AND OLSR=ODSR " & _
"where oltc='" & Sheet1.Range("A2").Text & "' and olyy='" & Sheet1.Range("b2").Text & "' and olchr='" & Sheet1.Range("c2").Text & "' and olno='" & Sheet1.Range("d2").Text & "' AND OLSR=" & res.Fields.Item(4) & " " & _
"GROUP BY OLSR,OLTC,OLYY,OLNO,OLSRNO,OLMCD,olqw,odsalprc "

res4.CursorLocation = adUseClient
res4.Open sql4, con
If res4.RecordCount = 0 Then
res4.Close
Set res4 = Nothing
Else
For z1 = 0 To res4.RecordCount - 1
If res4.Fields.Item(5) = "RHO" Then
Sheet2.Range("J63").Value = res4.Fields.Item(7)
Sheet2.Range("G65").Value = res4.Fields.Item(8)
Sheet2.Range("D66").Value = res4.Fields.Item(8)
End If
res4.MoveNext
Next
End If
If res4.EOF Then res4.Close
sql5 = "select ortc,oryy,orchr,orno,orsr,sum(orsalval),(sum(orwt)-0.02) as 'GrantCaratweight' from ordrm " & _
" where ortc='" & Sheet1.Range("A2").Text & "' and ORRMCTG in ('D','C') AND oryy='" & Sheet1.Range("b2").Text & "' and orchr='" & Sheet1.Range("c2").Text & "' " & _
" and orno='" & Sheet1.Range("d2").Text & "' and orsr='" & res.Fields.Item(4) & "'" & _
" group by ortc,oryy,orchr,orno,orsr"

res5.CursorLocation = adUseClient
res5.Open sql5, con
If res5.RecordCount = 0 Then
res5.Close
Set res5 = Nothing
Else
For z2 = 0 To res5.RecordCount - 1
Sheet2.Range("J64").Value = res5.Fields.Item(5)
Sheet2.Range("D49").Value = res5.Fields.Item(6) & "ct"
res5.MoveNext
Next
End If
If res5.EOF Then res5.Close
sql6 = "select ortc,oryy,orchr,orno,orsr,orrmptr,orqty,orln1,(case when orrmsctg='CHN' THEN 'CHAIN' WHEN ORRMSCTG='LLS' THEN 'LOBSTER LOCK' WHEN ORRMSCTG='RND' THEN 'ROUND' ELSE ORRMSCTG END) AS 'ORRMSCTG',orwt from ordrm where ortc='" & Sheet1.Range("A2").Text & "' and orno='" & Sheet1.Range("d2").Text & "' and orchr='" & Sheet1.Range("c2").Text & "' and oryy='" & Sheet1.Range("b2").Text & "' and orsr='" & res.Fields.Item(4) & "' and orrmctg in ('d','c')"

res6.CursorLocation = adUseClient
res6.Open sql6, con
If res6.RecordCount = 0 Then
res6.Close
Set res6 = Nothing
Else
For y1 = 0 To res6.RecordCount - 1
'Sheet2.Range("M53").Value = res6.Fields.Item(5)
Sheet3.Range("G" & 1 + y1).Value = res6.Fields.Item(5) & "ct"
'Sheet2.Range("M49").Value = res6.Fields.Item(8)
Sheet3.Range("D" & 1 + y1).Value = res6.Fields.Item(8)
'Sheet2.Range("M55").Value = res6.Fields.Item(9) & "ct"
Sheet3.Range("I" & 1 + y1).Value = res6.Fields.Item(9) & "ct"
'Sheet2.Range("M54").Value = res6.Fields.Item(6)
Sheet3.Range("H" & 1 + y1).Value = res6.Fields.Item(6)
If res6.Fields.Item(8) = "RND" Then
Select Case res6.Fields.Item(7)
Case 0.003:
Sheet2.Range("E" & 1 + y1).Value = "0.90mm"
Case 0.03:
Sheet3.Range("E" & 1 + y1).Value = "1.00mm"
Case 0.02:
Sheet3.Range("E" & 1 + y1).Value = "1.10mm"
Case 0.01:
Sheet3.Range("E" & 1 + y1).Value = "1.15mm"
Case 1:
Sheet3.Range("E" & 1 + y1).Value = "1.20mm"
Case 1.5:
Sheet3.Range("E" & 1 + y1).Value = "1.25mm"
Case 2:
Sheet3.Range("E" & 1 + y1).Value = "1.30mm"
Case 2.5:
Sheet3.Range("E" & 1 + y1).Value = "1.35mm"
Case 3:
Sheet3.Range("E" & 1 + y1).Value = "1.40mm"
Case 3.5:
Sheet3.Range("E" & 1 + y1).Value = "1.45mm"
Case 4:
Sheet3.Range("E" & 1 + y1).Value = "1.50mm"
Case 4.5:
Sheet3.Range("E" & 1 + y1).Value = "1.55mm"
Case 5:
Sheet3.Range("E" & 1 + y1).Value = "1.60mm"
Case 5.5:
Sheet3.Range("E" & 1 + y1).Value = "1.70mm"
Case 6:
Sheet3.Range("E" & 1 + y1).Value = "1.80mm"
Case 6.5:
Sheet3.Range("E" & 1 + y1).Value = "1.90mm"
Case 7:
Sheet3.Range("E" & 1 + y1).Value = "2.00mm"
Case 7.5:
Sheet3.Range("E" & 1 + y1).Value = "2.10mm"
Case 8:
Sheet3.Range("E" & 1 + y1).Value = "2.20mm"
Case 8.5:
Sheet3.Range("E" & 1 + y1).Value = "2.30mm"
Case 9:
Sheet3.Range("E" & 1 + y1).Value = "2.40mm"
Case 9.5:
Sheet3.Range("E" & 1 + y1).Value = "2.50mm"
Case 10:
Sheet3.Range("E" & 1 + y1).Value = "2.60mm"
Case 10.5:
Sheet3.Range("E" & 1 + y1).Value = "2.70mm"
Case 11:
Sheet3.Range("E" & 1 + y1).Value = "2.80mm"
Case 11.5:
Sheet3.Range("E" & 1 + y1).Value = "2.90mm"
Case 12:
Sheet3.Range("E" & 1 + y1).Value = "3.00mm"
Case 12.5:
Sheet3.Range("E" & 1 + y1).Value = "3.10mm"
Case 13:
Sheet3.Range("E" & 1 + y1).Value = "3.20mm"
Case 13.5:
Sheet3.Range("E" & 1 + y1).Value = "3.30mm"
Case 14:
Sheet3.Range("E" & 1 + y1).Value = "3.40mm"
Case 14.5:
Sheet3.Range("E" & 1 + y1).Value = "3.50mm"
Case 15:
Sheet3.Range("E" & 1 + y1).Value = "3.60mm"
Case 15.5:
Sheet3.Range("E" & 1 + y1).Value = "3.70mm"
Case Else:
Sheet3.Range("E" & 1 + y1).Value = res6.Fields.Item(7) & "mm"
End Select
Else
Sheet3.Range("E" & 1 + y1).Value = res6.Fields.Item(7) & "mm"
End If
res6.MoveNext
Next

End If
Sheet3.coltorow3
Sheet3.coltorow5
Sheet3.coltorow6
Sheet3.coltorow7
Sheet3.coltorow2
If res6.EOF Then res6.Close

sql7 = "SELECT ORTC,ORYY,ORCHR,ORNO,ORSR,CRCUSTRMCD,(case when crdesc='Round Single cut' then 'single cut' when crdesc='Round Full Cut'then 'full cut' else crdesc end) as 'Crdesc' FROM ORDRM INNER JOIN ORDMST ON ORTC=OMTC AND ORYY=OMYY AND ORCHR=OMCHR AND ORNO=OMNO INNER JOIN " & _
" CUSTRM ON CROURRMCD=ORRMCD WHERE CRCD=OMCMCD AND ortc='" & Sheet1.Range("A2").Text & "' and orno='" & Sheet1.Range("d2").Text & "' and orchr='" & Sheet1.Range("c2").Text & "' and oryy='" & Sheet1.Range("b2").Text & "' and orsr=" & res.Fields.Item(4) & " " & _
" and orrmctg in ('d','c')"


res7.CursorLocation = adUseClient
res7.Open sql7, con
If res7.RecordCount = 0 Then
res7.Close
Set res7 = Nothing
Else
For y2 = 0 To res7.RecordCount - 1
Sheet3.Range("F" & 1 + y2).Value = res7.Fields.Item(5)
'Sheet2.Range("M47").Value = res7.Fields.Item(6)
Sheet3.Range("B" & 1 + y2).Value = res7.Fields.Item(6)
res7.MoveNext
Next

End If
Sheet3.coltorow4
Sheet3.Coltorow1
If res7.EOF Then res7.Close
sql8 = "select OLTC,OLYY,OLCHR,OLNO,OLSR,(CASE WHEN OLMCD='RHO' THEN 'Rhodium Plate' ELSE '' END) AS 'OLMCD' from ordlab where oltc='" & Sheet1.Range("A2").Text & "' and olyy='" & Sheet1.Range("b2").Text & "'and olchr='" & Sheet1.Range("c2").Text & "' and olno='" & Sheet1.Range("d2").Text & "' and olsr=" & res.Fields.Item(4) & " and olmcd='RHO'"

res8.CursorLocation = adUseClient
res8.Open sql8, con
If res8.RecordCount = 0 Then
res8.Close
Set res8 = Nothing
Else
For y3 = 0 To res8.RecordCount - 1
Sheet2.Range("D53").Value = res8.Fields.Item(5)
res8.MoveNext
Next
End If
If res8.EOF Then res8.Close
sql9 = "SELECT ODTC,ODNO,ODSR,ODDMCOL,PMCD,PDESC FROM ORDDSG INNER JOIN PARAM ON PMCD=ODDMCOL WHERE PTYP='DMCOL' AND ODTC='" & Sheet1.Range("A2").Text & "' AND ODYY='" & Sheet1.Range("b2").Text & "' AND ODCHR='" & Sheet1.Range("c2").Text & "' AND ODNO='" & Sheet1.Range("d2").Text & "' and ODSR='" & res.Fields.Item(4) & "'"

res9.CursorLocation = adUseClient
res9.Open sql9, con

If res9.RecordCount = 0 Then
res9.Close
Set res9 = Nothing
Else
For y4 = 0 To res9.RecordCount - 1
Sheet2.Range("D51").Value = res9.Fields.Item(5)
Sheet2.Range("D54").Value = "Polished"
res9.MoveNext
Next
End If
If res9.EOF Then res9.Close

sql10 = "select cmcurcd from custmst where cmcd='kp029'"


res10.CursorLocation = adUseClient
res10.Open sql10, con

If res10.RecordCount = 0 Then
res10.Close
Set res10 = Nothing
Else
For y5 = 0 To res10.RecordCount - 1
Sheet2.Range("J61").Value = res10.Fields.Item(0)
res10.MoveNext
Next
End If
If res10.EOF Then res10.Close

'written by saurabh sharma for weight of metal on 20/4/13

sql11 = "select round((sum(orwt)*0.90),3) as 'weightofmetal' from ordrm where ortc='" & Sheet1.Range("A2").Text & "' and orno='" & Sheet1.Range("d2").Text & "' and ORCHR='" & Sheet1.Range("c2").Text & "' AND ORYY='" & Sheet1.Range("b2").Text & "' and orsr='" & res.Fields.Item(4) & "'AND ORRMCTG NOT IN ('D','C')"


res11.CursorLocation = adUseClient
res11.Open sql11, con


If res11.RecordCount = 0 Then
res11.Close
Set res11 = Nothing
Else
For y6 = 0 To res11.RecordCount - 1
Sheet2.Range("D52").Value = res11.Fields.Item(0) & "g"
res11.MoveNext
Next
End If
If res11.EOF Then res11.Close
'End
sql12 = "select round((Sum(B.OrPrdWt/(Case When B.OrRmCtg in ('D','C') Then 5 Else 1 End))*0.90),3) from ordrm as b where ortc='" & Sheet1.Range("A2").Text & "' and orno='" & Sheet1.Range("d2").Text & "' and ORCHR='" & Sheet1.Range("c2").Text & "' AND ORYY='" & Sheet1.Range("b2").Text & "' and orsr='" & res.Fields.Item(4) & "'"


res12.CursorLocation = adUseClient
res12.Open sql12, con

If res12.RecordCount = 0 Then
res12.Close
Set res12 = Nothing
Else
For y7 = 0 To res12.RecordCount - 1
Sheet2.Range("D27").Value = res12.Fields.Item(0)
res12.MoveNext
Next
End If
If res12.EOF Then res12.Close

sql13 = "SELECT OLTC,OLYY,OLCHR,OLNO,OLSR,OLMCD,OLSALVAL FROM ordlab where oltc='" & Sheet1.Range("A2").Text & "' and olyy='" & Sheet1.Range("b2").Text & "' and olchr='" & Sheet1.Range("c2").Text & "' and olno='" & Sheet1.Range("d2").Text & "' and olsr='" & res.Fields.Item(4) & "' and olmcd in ('FND')"

res13.CursorLocation = adUseClient
res13.Open sql13, con

If res13.RecordCount = 0 Then
Sheet2.Range("D63").Value = "0.00"
' res13.Close
'Set res13 = Nothing
Else
For y8 = 0 To res13.RecordCount - 1
Sheet2.Range("D63").Value = res13.Fields.Item(6)
res13.MoveNext
Next
End If
If res13.EOF Then res13.Close

sql14 = "select DISTINCT len(oddmcol) AS 'LENODDMCOL',oddmcol,ORRMCTG,ODKT,PMCD,PDESC,(ODKT +' '+case when len(oddmcol)=1 then Pdesc when len(oddmcol)=2 then 'Two Tone' when len(oddmcol)=3 then 'Tri-Casted' else '' end + ' ' + case when orrmctg='D' then 'Diamond' end) as 'Breif Desc' FROM ORDDSG INNER JOIN PARAM ON PMCD=ODDMCOL INNER JOIN ORDRM ON ORTC=ODTC AND ORYY=ODYY AND ORCHR=ODCHR AND ORNO=ODNO AND ODSR=ORSR WHERE PTYP='DMCOL' AND ODTC='" & Sheet1.Range("A2").Text & "' AND ODYY='" & Sheet1.Range("b2").Text & "' AND ODCHR='" & Sheet1.Range("c2").Text & "' AND ODNO='" & Sheet1.Range("d2").Text & "' and ODSR=" & res.Fields.Item(4) & " and orrmctg in ('D')"

res14.CursorLocation = adUseClient
res14.Open sql14, con

If res14.RecordCount = 0 Then
res14.Close
Set res14 = Nothing
Else
For y9 = 0 To res14.RecordCount - 1
Sheet2.Range("D18").Value = res14.Fields.Item(6) & " " & res.Fields.Item(12)
res14.MoveNext
Next
End If
If res14.EOF Then res14.Close
sql15 = "SELECT oltc,olyy,olchr,olno,olsr,olsrno,olscd,pdesc,(case when pscd in ('pst','PST08','PST09','PST10','PST14','PST18','PST925') then 'Click Post' when pscd in ('PSBF08','PSBF09','PSBF10','PSBF14','PSBF18','PSBF925') then 'Post and Butterfly' else 'NA' end) as [desc] FROM ordlab inner join param on olmcd=pmcd and olscd=pscd WHERE OlTC='" & Sheet1.Range("A2").Text & "' AND OlYY='" & Sheet1.Range("b2").Text & "' AND OlCHR='" & Sheet1.Range("c2").Text & "' AND OlNO='" & Sheet1.Range("d2").Text & "' AND OlSR=" & res.Fields.Item(4) & " and ptyp='labscd' and olmcd='FND'"


res15.CursorLocation = adUseClient
res15.Open sql15, con

If res15.RecordCount = 0 Then
Sheet2.Range("D56").Value = "NA"
'res15.Close
'Set res15 = Nothing
Else
For y10 = 0 To res15.RecordCount - 1
Sheet2.Range("D56").Value = res15.Fields.Item(8)
res15.MoveNext
Next
End If
If res15.EOF Then res15.Close
sql16 = "select omtc,omyy,omchr,omno,omcmcd,omlmgcst from ordmst where omtc='" & Sheet1.Range("A2").Text & "' and omyy='" & Sheet1.Range("b2").Text & "' and omchr='" & Sheet1.Range("c2").Text & "' and omno='" & Sheet1.Range("d2").Text & "'"
res16.CursorLocation = adUseClient
res16.Open sql16, con

If res16.RecordCount = 0 Then
res16.Close
Set res16 = Nothing
Else
For y9 = 0 To res16.RecordCount - 1
Sheet2.Range("J66").Value = res16.Fields.Item(5)
res16.MoveNext
Next
End If
If res16.EOF Then res16.Close
sql17 = "SELECT OLTC,OLYY,OLCHR,OLNO,OLSR,SUM(OLSALVAL) FROM ORDLAB WHERE OLTC='" & Sheet1.Range("A2").Text & "' AND OLYY='" & Sheet1.Range("b2").Text & "' AND OLCHR='" & Sheet1.Range("c2").Text & "' AND OLNO='" & Sheet1.Range("d2").Text & "' AND OLSR=" & res.Fields.Item(4) & " AND OLMCD='CFP' GROUP BY OLTC,OLYY,OLCHR,OLNO,OLSR"

res17.CursorLocation = adUseClient
res17.Open sql17, con

If res17.RecordCount = 0 Then
res17.Close
Set res17 = Nothing
Else
For y12 = 0 To res17.RecordCount - 1
Sheet2.Range("G62").Value = res17.Fields.Item(5)
res17.MoveNext
Next
End If
If res17.EOF Then res17.Close
Sheet2.Name = res.Fields.Item("ODDMCD")
Sheet2.Copy
Sheet2.Visible = xlSheetVeryHidden
Filename = mDirName & "\" & res.Fields.Item(7) & "_" & res.Fields.Item(4)
Call Application.ActiveWorkbook.SaveAs(Filename & ".xls")
ActiveWorkbook.Close
res.MoveNext
If res.EOF Then res.Close
Call clear
Next
End If
Exit Sub
errhandler:
If Err.Number = 1004 Then
Resume Next
Else
MsgBox Err.Description
End If
con.Close


Set con = Nothing
End Sub
Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub

Set p = Sheet2.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.count).Left - .Left
h = .Offset(.Rows.count, 0).Top - .Top
End With
' position picture
With p
.Top = t + 15
.Left = l + 50
.Width = w - 200
'.Height = h + 255
.Height = h + 265
End With
Set p = Nothing
End Sub

 

[sijpie]

saurabhrahulsharma your code is far too long and complicated for anyone to go through.
First of all, please, if you enter code - put it between code brackets - use 'Go Advanced' for reply and press the button with # to insert the code brackets (

 [/ code]). Then paste your code between the ] and [, so you get [code] your macro here [/ code]

For this problem I suggest you make a copy of your macro, and start cutting stuff out, to make it simpler, so you can see when the error starts popping up.

VBA has a great debugger, particularly if you work on two screens or have a large screen where you can show your spreadsheet next to the macro editor. put your cursor in the sub, then press F8 key to walk through the macro step by step. There are some other methods you can use as well, do a google search on debugging in VBA.

When you have simplified your code and narrowed down where the error is, but still can't find it, then please come back here.