|
Try this:
Me.txtChannelData(arrIndex).Invoke(New Action(Of Integer, String)(AddressOf SettxtChannelData), arrIndex, s)
"These people looked deep within my soul and assigned me a number based on the order in which I joined."
- Homer
|
|
|
|
|
Nope:
Me.txtChannelData(arrIndex).Invoke(New Action(Of Integer, String)(AddressOf SettxtChannelData), arrIndex, s)
Getting the error 'Too many type arguments to 'system.action(of T)'' on the "(Of Integer, String)" portion
|
|
|
|
|
If you are you using a version below .NET 3 the generic delegate suggested by Richard is not available and so you'll need to define one.
e.g.
|
|
|
|
|
Hi all!
I have trouble passing arguments to the Process.Start in VB.NET.
What I want to accomplish is to backup a mysql database with its mysqldump.exe which is located in my C drive. I have a code that can do it perfectly when run in the command prompt. The problem if face comes when I want to pass that same code to the process.start.
The code that does the work is :
"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"""
To be sure, I broke the code into two blocks, and I placed them to two textboxes as follows:
txtProgram.Text = "C:\Program Files\MySQL\MySQL Server 5.5\bin\mysqldump.exe" ,
txtArguments.Text= "--user=root --password=mypassword --host=localhost --port=3306 --database sakila >"C:\backup\sakilabackup.sql"""
Then I did this:
System.Diagnostics.Process.Start(txtProgram.Text, txtArguments.Text)
And it still bring me the error "The system cannot find the file specified" Error message.
Can you please tell me what the problem is and how I can get through it? Please remember that, if I take the contents of txtProgram.text and txtArguments.text and put them to a command prompt, it works fine.
*I have also searched other threads here, no one had an exact similar issue like mine.
I will appreciate any help.
(I use VB 2010)
|
|
|
|
|
Oops - incorrect message redacted.
Use the best guess
modified 2-May-13 7:26am.
|
|
|
|
|
Richard MacCutchan wrote: backslashes are escape characters in strings
Not in VB. 
"These people looked deep within my soul and assigned me a number based on the order in which I joined."
- Homer
|
|
|
|
|
#!%@#! That's the second time I've made this stupid mistake recently. 
Use the best guess
|
|
|
|
|
Thanks for offering to help though!
I tried it and did not work (well, at least it doesn't say "..Can not file the file specified" which is the error msg I've been getting)
If you can offer more help I will appreciate.
|
|
|
|
|
savedlema wrote: --user=root --password=mypassword --host=localhost --port=3306 --database sakila
Based on the other params; I'd expect a "="-sign between the words "database" and "sakila".
Bastard Programmer from Hell 
If you can't read my code, try converting it here[^]
|
|
|
|
|
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.
|
|
|
|
|
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!)
|
|
|
|
|
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.
|
|
|
|
|
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.
|
|
|
|
|
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.
|
|
|
|
|
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.
|
|
|
|
|
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!
|
|
|
|
|
|
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.
|
|
|
|
|
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 
Cheers!
|
|
|
|
|
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.
|
|
|
|
|
Indeed, plain Rich Text Format, the one WordPad has used ever since Windows 3.0 Means the file format could well be older than Word itself
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!
|
|
|
|
|
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
|
|
|
|
|
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)
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))
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)
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))
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)
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))
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)
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))
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)
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))
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)
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))
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)
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))
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)
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))
Next i
End Sub
|
|
|
|
|
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))
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
|
|
|
|
|
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...
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
