Re: Word VBA: quickly checking if table is uniform from 3rd row on - Visual Basic Discussion Boards

Re: Trouble passing arguments to System.Diagnostics.Process.Start

Alan N2-May-13 5:44

2-May-13 5:44

savedlema wrote:
Please remember that, if I take the contents of txtProgram.text and txtArguments.text and put them to a command prompt, it works fine.

You are writing the output of mysqldump into a file using the redirection operator >. This is implemented by the command processor, cmd.exe and to get the same effect using Process.Start the various bits should be

Process.Start ( Environment.GetEnvironmentVariable("COMSPEC"),
  "/c ""C:\Program Files\MySQL\MySQL Server 5.5\bin\mysqldump.exe"" --user=root --password=mypassword --host=localhost --port=3306 --database sakila > ""C:\backup\sakilabackup.sql""")

Environment.GetEnvironmentVariable("COMSPEC") resolves to the path of the command processor and is convenient way of locating that program on any system. The arguments are now the command line you would have typed at the prompt, prefixed by /c to tell the command processor to exit once mysqldump has ended. Check all the quotes as I may have these wrong, VB isn't my usual language.

One thing to watch out for when using Process.Start is the working directory. If this needs setting then you should create a ProcessStartInfo object and use the correct overload of Process.Start.

Alan.

Re: Trouble passing arguments to System.Diagnostics.Process.Start

savedlema2-May-13 8:01

savedlema

2-May-13 8:01

Thank you Alan!
But, I tried your suggested code and, when I run it, a small command prompt window appears and goes away suddenly without giving me time to read it, but I have been able to read that it brings that error message that says ".....is not recognized as internal or external program..batch file..."

But, at least its not saying "the system can not find the file specified"

Do you have any other idea on this? (Sounds like the solution is only few miles ahead!)

Re: Trouble passing arguments to System.Diagnostics.Process.Start

Alan N2-May-13 8:17

Alan N

2-May-13 8:17

Change the /c in the arguments to /k. This will keep the window open after the command has run and let you see what's wrong.

Process.Start ( Environment.GetEnvironmentVariable("COMSPEC"),
  "/k ""C:\Program ..... etc

The message "is not recognized as internal or external program" should be prefixed with the name of the program that can't be found.

Alan.

Re: Trouble passing arguments to System.Diagnostics.Process.Start

savedlema3-May-13 0:54

savedlema

3-May-13 0:54

Hi Alan!
Thanks so much for that. I tried it, and as you said, now I'm able to see what's in the command window.
The error msg is this:

Quote:
'C:\Program' is not recognized as an internal or external command,
operable program or batch file.

I will appreciate more help with this, please.
Thanks.

Re: Trouble passing arguments to System.Diagnostics.Process.Start

Alan N3-May-13 2:57

Alan N

3-May-13 2:57

If the pathname isn't quoted correctly the command processor will assume that it ends at the first space character.

It may be helpful check that the strings are correct by dumping them to a textbox or the console.
e.g.

Module Module1
  Sub Main()
    Dim cmd As String = Environment.GetEnvironmentVariable("COMSPEC")
    Dim args As String = "/k ""C:\Program Files\MySQL\MySQL Server 5.5\bin\mysqldump.exe"" --user=root --password=mypassword --host=localhost --port=3306 --database sakila > ""C:\backup\sakilabackup.sql"""
    System.Console.WriteLine(cmd)
    System.Console.WriteLine()
    System.Console.WriteLine(args)
  End Sub
End Module

I assume that is correct as the console shows the pathname for mysqldump quoted correctly.

C:\WINDOWS\system32\cmd.exe

/k "C:\Program Files\MySQL\MySQL Server 5.5\bin\mysqldump.exe" --user=root --password=mypassword --host=localhost --port=3306 --
database sakila > "C:\backup\sakilabackup.sql"

Alan.

Re: Trouble passing arguments to System.Diagnostics.Process.Start

savedlema3-May-13 4:24

savedlema

3-May-13 4:24

Thanks Alan,

But sorry, I'm kind of a novice here; I created the module as in your reply, but what do I do with it? How do I run what's in that module?

I could only go as far as saying "Call module1.Main()" how should I proceed to run what's inside?

Thanks so far..

modified 3-May-13 10:32am.

Word VBA: quickly checking if table is uniform from 3rd row on

Bart Van Eyndhoven1-May-13 23:08

Bart Van Eyndhoven

1-May-13 23:08

Hi guys,

This might be a little tricky, I don't even know if it's possible.

I've got some code working, but to optimize the performance, I'd like to rewrite parts of it to enhance the performance.

The tables that need to be processed start with a merged cell (spanning all columns), but can be interrupted by another row where all cells are merged. The 2nd row always contains the same text but does not have to be processed.

I'm looking for some time now for an answer to the following questions:
* Is there a way to check if a table is uniform from the 3rd row on? Looping works, but it gets slow on long tables, so I want to avoid looping if possible.
* If the table is not uniform, is there a way to know wich rows are merged (also without looping if possible)?
* One column is populated with ID numbers, wich consist of a number, a linebreak (not a paragraph break) and a code. I want to set the font size for the number to 8 and the font size for the code to 1. Is there a way to apply this to the whole column at once instead of looping trough the cells?

If there's no way to avoid looping, it's not too bad. I've got the code working now, using loops, but since it can take over 5 minutes processing a table of say 600 rows (45 pages), I'm just looking for ways to increase performance.

Thanks in advance!

Cheers!

Re: Word VBA: quickly checking if table is uniform from 3rd row on

Kenneth Haugland2-May-13 2:28

Kenneth Haugland

2-May-13 2:28

I dont actually know, but transforming it to excel and than an array might be much quicker:
http://word.mvps.org/faqs/tblsfldsfms/FastTables.htm[^]
http://www.ehow.com/how_12187111_improve-microsoft-word-vba-table-slowness.html[^]
http://www.ehow.com/how_7224789_access-tables-using-excel-vba.html[^]

Re: Word VBA: quickly checking if table is uniform from 3rd row on

Kenneth Haugland2-May-13 2:37

Kenneth Haugland

2-May-13 2:37

What kind of Word File are we talking about anyway?
if they are docx they migh be stored as a zip file. Than they are just xml files, and then you could do Linq or other things, they might be much faster.

Re: Word VBA: quickly checking if table is uniform from 3rd row on

Bart Van Eyndhoven2-May-13 4:23

Bart Van Eyndhoven

2-May-13 4:23

Too bad... It's RTF... And the processing involves formatting, that's why taking it out of the document isn't really an option. But it's just a performance tweak Smile | :)

Cheers!

Re: Word VBA: quickly checking if table is uniform from 3rd row on

Kenneth Haugland2-May-13 4:54

Kenneth Haugland

2-May-13 4:54

RTF = Rich Textbox Format?
BTW: it seems all newer formats of Office, that have the x after, like xlsx are stored as xml's in a zip file.

Re: Word VBA: quickly checking if table is uniform from 3rd row on

Bart Van Eyndhoven2-May-13 21:51

Bart Van Eyndhoven

2-May-13 21:51

Indeed, plain Rich Text Format, the one WordPad has used ever since Windows 3.0 Smile | :)

Means the file format could well be older than Word itself Smile | :)

The processing involves formatting, so exporting it to another program (like Excel) isn't really an option. I doubt there is a way to avoid the loops.

The macro runs from a userform (just to provide feedback). I start by setting Application.ScreenUpdate = False, and I regulary use Application.ScreenRefresh.

All of my loops end by calling the DoEvents statement. It's just to prevent Word from showing inresponsive. Elsewise, the user might think Word has crashed and force closure of the process. Maybe I used the DoEvents the wrong way...

Cheers!

Re: Word VBA: quickly checking if table is uniform from 3rd row on

TnTinMn4-May-13 5:33

TnTinMn

4-May-13 5:33

Quote:
Is there a way to check if a table is uniform from the 3rd row on? Looping works, but it gets slow on long tables, so I want to avoid looping if possible.

It has been a long time since I did Word vba, but I think something like the following should do the trick for this part of your request.

Do note that I did not include any error handling in this.

Private Function TableIsUniformAfterRow(tbl As Table, row As Integer, sourcedoc As Document) As Boolean
    Dim app As Application
    Set app = sourcedoc.Application
    Dim tmpdoc As Document
    Set tmpdoc = app.Documents.Add(, , , False)
    app.Activate
    sourcedoc.Activate
    tbl.Select
    Selection.Copy
    Dim isuni As Boolean
    With tmpdoc
        .Activate
        Selection.Paste
        Dim i As Integer
        For i = 1 To row
            .Tables(1).Rows(1).Delete
        Next i
        TableIsUniformAfterRow = .Tables(1).Uniform
        .Close (False)
    End With
End Function

VB Macro one sheet is corrupt

saurabhrahulsharma1-May-13 16:59

saurabhrahulsharma

1-May-13 16:59

when i am creating a macro,one or more sheet has been corrupt automatically,it is giving wrong data,i am not understanding the problem.plz help me where i am getting problem.The code is like.

This Code is written in sheet 1,and sheet 2 is for display the data,and in sheet3 is used for transforming data.

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 omtc,omyy,omchr,omno,odsr,omdt,drrmctg,drrmsctg,rmdesc,drrmcd,rmcol,drwt," & _
' "dmctg,DRLN1,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',omlmgcst " & _
'"FROM RMMST INNER JOIN DSGRM ON DRRMCTG=RMCTG AND DRRMSCTG=RMSCTG AND DRRMCD=RMCD inner join " & _
' "dsgmst on drtctyp=dmtctyp and drcd=dmcd inner join " & _
' "orddsg on dmcd=oddmcd inner join " & _
' "ordmst on omtc=odtc and omyy=odyy and omchr=odchr and omno=odno " & _
'"WHERE DRTCTYP='DM' AND DRRMCTG='D' AND 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) & " "

'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
-------------------++++++-----------------------
Sheet3 code

Public Sub coltorow()
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, "A"), Cells(lastrow, "A")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 38, "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
Public Sub Coltorow1()
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, "B"), Cells(lastrow, "B")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 39, "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
Public Sub coltorow2()
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, "D"), Cells(lastrow, "D")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 41, "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
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
Public Sub coltorow4()
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, "F"), Cells(lastrow, "F")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 43, "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
Public Sub coltorow5()
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, "G"), Cells(lastrow, "G")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 45, "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
Public Sub coltorow6()
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, "H"), Cells(lastrow, "H")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 46, "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
Public Sub coltorow7()
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, "I"), Cells(lastrow, "I")).SpecialCells(xlCellTypeConstants)
'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
Sheet2.Cells(i + 47, "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

----------++++++++++----------------------
Sheet3 code

Public Sub coltorow()
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, "A"), Cells(lastrow, "A")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 38, "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
Public Sub Coltorow1()
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, "B"), Cells(lastrow, "B")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 39, "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
Public Sub coltorow2()
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, "D"), Cells(lastrow, "D")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 41, "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
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
Public Sub coltorow4()
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, "F"), Cells(lastrow, "F")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 43, "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
Public Sub coltorow5()
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, "G"), Cells(lastrow, "G")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 45, "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
Public Sub coltorow6()
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, "H"), Cells(lastrow, "H")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 46, "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
Public Sub coltorow7()
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, "I"), Cells(lastrow, "I")).SpecialCells(xlCellTypeConstants)
 'Sheet1.Columns("D:Z").ColumnWidth = 21

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 47, "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

Re: VB Macro one sheet is corrupt

JR2121-May-13 20:31

JR212

1-May-13 20:31

Hi,

1 but your code between pre tags
2 move some of your code into a module
3 split your subs into smaller ones
4 I see a lot of this:

For i = 1 To rng.Areas.count
        Sheet2.Cells(i + 38, "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

So re-use your code and create other subs and call them with a parameter
once you have don this maybe your problem is solved. Remember each module form or sheet has a max of 64K

Jan

Re: VB Macro one sheet is corrupt

Kenneth Haugland2-May-13 1:24

Kenneth Haugland

2-May-13 1:24

There is simply too much information here, scale your problem down were you only include code that is relevant to the issue. I dont think people are going to debug your code for you so...

How can i Change Button Label Value Randomly in VIRTUAL KEYBOARD ???

Vivek1987agarwal1-May-13 10:03

Vivek1987agarwal

1-May-13 10:03

How can change Button Label value Every Time when i start Virtual Keyboard, Means ,if 1st time Button1=''a'' then next login time Button1 = " any Alphabet "...is this Possible through Probability Distribution & Counter...?

Re: How can i Change Button Label Value Randomly in VIRTUAL KEYBOARD ???

dusty_dex1-May-13 11:24

dusty_dex

1-May-13 11:24

You have also posted this question in Java forum. Thumbs Down | :thumbsdown:

Well which language is it, a VB or Java question?

Re: How can i Change Button Label Value Randomly in VIRTUAL KEYBOARD ???

Vivek1987agarwal1-May-13 20:49

Vivek1987agarwal

1-May-13 20:49

Give me Solution..in JAVA, VB, NetBeans solution, Dot Net

Re: How can i Change Button Label Value Randomly in VIRTUAL KEYBOARD ???

Richard MacCutchan1-May-13 21:24

Richard MacCutchan

1-May-13 21:24

Which? Please don't just dump in multiple forums and demand a solution. Choose one forum and explain your problem clearly.

Use the best guess

Re: How can i Change Button Label Value Randomly in VIRTUAL KEYBOARD ???

Vivek1987agarwal1-May-13 21:30

Vivek1987agarwal

1-May-13 21:30

Try to Give me Solution..in JAVA if its not possible in Java
then
try in VB or NetBeans solu Sothat i can use only Method from any other Languages or Plateform.

Re: How can i Change Button Label Value Randomly in VIRTUAL KEYBOARD ???

Richard MacCutchan1-May-13 22:04

Richard MacCutchan

1-May-13 22:04

Make up your mind which one you want, and explain your problem clearly. Your question, as it stands, makes no sense.

Use the best guess

SQL working in SQLPlus but not returning rows in VB.net using Oracle.OLEDB provider

liona1-May-13 3:14

liona

1-May-13 3:14

I have SQL that is returning 24 rows in SQLPlus however when I run the same query in VS2010 using Provider=OraOLEDB.Oracle its doesn't return any rows. I am using a LIKE operator with to_date. Any suggestions? Is it the provider I am using the problem?

See example

SQL

select level from testTable where dTime LIKE to_date('3/27/2013','MM/DD/YYYY') and station = '019654' order by dTime

I did try it with '%3/27/2013%'

Re: SQL working in SQLPlus but not returning rows in VB.net using Oracle.OLEDB provider

Simon_Whale1-May-13 3:24

Simon_Whale

1-May-13 3:24

Have you tried running the query in Oracle directly?

Every day, thousands of innocent plants are killed by vegetarians.

Help end the violence EAT BACON

Re: SQL working in SQLPlus but not returning rows in VB.net using Oracle.OLEDB provider

liona1-May-13 3:28

liona

1-May-13 3:28

yes and it works perfectly. I am using VS2010 if that makes a difference.

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.