Proble in Macro,data is not coming properly

See more:

VB

MS-Excel

macros

VBA

Hello Friends

When i am running my macro,if my order_no is like 1,2,3,4,5,6,7, i.e primary, that time it is giving garbage value.and sub order no is like 1,2,3,4,8,9 in this 5,6,7 are missing which is also primary key, when i enter order no 1 so it will keep the sub_order no also it may be 3 or 4 that time it will generate report, but when i m giving order no 132 and it have some sub order no. 1,2,6,7, here sub order 3,4,5 missing so this time report gives garbage data.

i m not getting any solution

in sheet1 i write this:
Sheet1

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:
                             Sheet1.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
If res6.EOF Then res6.Close

Sheet3 for transpose column data to row
on sheet3
Transpose data
-----------------------+++++++++++++--------------

Public Sub coltorow3()
Dim rng As Range
Dim i As Long
Dim lastrow As Long
lastrow = Cells(Rows.count, 1).End(xlUp).Row
Set rng = Range(Cells(1, "E"), Cells(lastrow, "E")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count

        Sheet2.Cells(i + 42, "D").Resize(1, rng.Areas(i).count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
        'Sheet2.Cells(i + 45, "W").Resize(1, rng.Areas(i).Count).Value = Application.WorksheetFunction.Transpose(rng.Areas(i))
Next i

End Sub

Desiered output like this

Stone Name & Colour  White Diamond   White Diamond									
Type  		     Single cut		Single cut									
Country of Origin    china                  china																													
Shape		    Round       		Round									
Stone Dimensions (L x W)1.15mm		1.1mm									
Diamond Grade	     H/I1			H/I1									
Non Permanent or Special Care Stone Treatment																					
Carat Weight	     0.0066ct		0.0056ct									
Quantity	    30			44									
Total Carat Weight  0.21ct		0.25ct