Macro is not working properly

[saurabhrahulsharma]

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.coltorow3If res6.EOF Then res6.Close</pre>
Sheet3 for transpose column data to row
on sheet3
Transpose data
-----------------------+++++++++++++--------------

​

Public Sub coltorow3()Dim rng As RangeDim i As LongDim lastrow As Longlastrow = Cells(Rows.count, 1).End(xlUp).RowSet rng = Range(Cells(1, "E"), Cells(lastrow, "E")).SpecialCells(xlCellTypeConstants) 'Sheet1.Columns("D:Z").ColumnWidth = 21For 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</pre>
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 </pre>

 

[ukmikeb]

Hi

Could you please wrap your code between [.code.] and [./code.] (nb remove the "."s before posting)

And post a sample of the spreadsheet results using the options in my signature.

The way your code is displayed is likely to deter people from trying to help you.

hth