+ Reply to Thread
Results 1 to 3 of 3

Basic Script to separate data using variable input into Excel .csv

Hybrid View

  1. 10-04-2013, 04:16 PM #1
    jimmyj2000
    jimmyj2000 is offline
    Registered User
    Join Date
    10-04-2013
    Location
    Michigan
    MS-Off Ver
    Excel 2002
    Posts
    9

    Basic Script to separate data using variable input into Excel .csv

    Hey guys, hope this is the right spot for this. So i have the following script I'm working on, but obviously don't know what I am doing. This is a Basic Script placed ito a PC DMIS part program (outside of Excel), and what it does when the paragraphs I have marked are left out is dump my measurement results into a spreadsheet in a format that works perfectly with our SPC software. What I'm trying to do with the two marked paragraphs is have an input box pop up, and data be separated into separate sheets (i.e by mold cavity number 1-5) based on that input:

    Sub Main

‘xl Declarations
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
Dim fs As Object
Dim ReportDim As String
Dim CheckDim As String


Dim Cavity As Object                                                         ‘start paragraph 1
Dim message, title, defaultValue As String
Dim myValue As Object
Dim InputBox As String
message = "Cavity"
title = "cavity"
defaultValue = "1"
myValue = InputBox(message, title, defaultValue)
If myValue = "" Then myValue = defaultValue                 ‘end paragraph 1

'Check To see If results file exists
FilePath = "C:\Excel PC DMIS\3K170 B2A\"
Set fs = CreateObject("Scripting.FileSystemObject") 
ResFileExists = fs.fileexists(FilePath &  ".xls")


'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbooks = xlapp.Workbooks
If ResFileExists = False Then
    TempFilename = FilePath & "Loop Template.xls"
Else
    TempFilename = FilePath &  ".xls"
End If
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
'Set xlSheet = xlWorkbook.Worksheets("Sheet1")                   ‘start paragraph 2
 
Dim sh As Worksheets, flg As Boolean
For Each sh In Worksheets
      If sh.Name = cavity Then flg = True: Exit For
Next

If flg = False Then
    Sheets.Add.Name = cavity
End If

Set xlSheet = xlWorkbook.Worksheets(cavity)                          ‘end paragraph 2


If ResFileExists = False Then
    RCount=6
    CCount=3
    xlSheet.Range("B1").Value = Part.PartName
    xlSheet.Range("A6").Value = Date() & " " & Time()
    xlSheet.Range("B6").Value = "Inspector Name"
    For Each Cmd In Cmds
        'Eliminate DATDEF's
        If Cmd.Type <> 1299 Then
            'Do Dimensions
            If Cmd.IsDimension Then
                If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                End If
                If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                    Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                    If CheckDim <> "" Then
                            ReportDim = CheckDim
                    End If
                    If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                        If DCmd.ID = "" Then
                                xlSheet.Cells(5,CCount).Value = DimID & "."& DCmd.AxisLetter
                        Else
                                xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "M"
                        End If
                                xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                'Measured Or Deviation With check For True Position
      		        If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(6,CCount).Value = DCmd.Measured
		        Else
                                  xlSheet.Cells(6,CCount).Value = DCmd.Deviation
		        End If
                                'Add Min/Max For Profile dimensions
                                If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  CCount=CCount+1
                                  xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Max"
                                  xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                  xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                  xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                  xlSheet.Cells(6,CCount).Value = DCmd.Max
                                  CCount=CCount+1
                                  xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Min"
                                  xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                  xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                  xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                  xlSheet.Cells(6,CCount).Value = DCmd.Min
                                End If
                                CCount=CCount+1
                    End If
                End If
            End If
            'Do GDT
            If Cmd.Type = 184 Then
                  ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                  If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                        xlSheet.Cells(5,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                        xlSheet.Cells(2,CCount).Value = "0"
                        xlSheet.Cells(3,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                        xlSheet.Cells(4,CCount).Value = "0"
                        xlSheet.Cells(6,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
                        CCount=CCount+1
                  End If
            End If
        End If
    Next Cmd


Else

'Find first Open column.
RCount=6
Found=0
Do Until Found = 1
RCount = RCount + 1
If xlSheet.Cells(RCount,1).Value = "" Then
Found=1
End If
Loop

xlSheet.Cells(RCount,1).Value = Date() & " " & Time()
xlSheet.Cells(RCount,2).Value= "Inspector Name"

'Fill In measured data
CCount = 3
    For Each Cmd In Cmds
        'Eliminate DATDEF's
        If Cmd.Type <> 1299 Then
            'Do Dimensions
            If Cmd.IsDimension Then
                If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                End If
                If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                    Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                    If CheckDim <> "" Then
                            ReportDim = CheckDim
                    End If
                    If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                'Measured Or Deviation With check For True Position
      	                    If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Measured
		        Else
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation
		        End If
                                'Add Min/Max For Profile dimensions
                                If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  CCount=CCount+1
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Max
                                  CCount=CCount+1
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Min
                                End If
                       Ccount=Ccount+1
                    End If
                End If
            End If
            'Do GDT
            If Cmd.Type = 184 Then
                  ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                  If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                        xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                        xlSheet.Cells(RCount,CCount).Value = "0"
                        xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                        xlSheet.Cells(RCount,CCount).Value = "0"
                        xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
                        CCount=CCount+1
                  End If
            End If
        End If
    Next Cmd
End If


'Save And Cleanup
Set xlSheet = Nothing 
SaveName = FilePath & Part.partname & ".xls"
If ResFileExists = False Then
xlWorkBook.SaveAs SaveName
Else
xlWorkBook.Save
End If
xlWorkbook.Close
Set xlWorkbook = Nothing 
xlWorkbooks.Close 
Set xlWorkbooks = Nothing 
xlApp.Quit 
Set xlApp = Nothing

LabelEnd:

End Sub
    Reply With QuoteRegister To Reply
  2. 10-04-2013, 05:27 PM #2
    jimmyj2000
    jimmyj2000 is offline
    Registered User
    Join Date
    10-04-2013
    Location
    Michigan
    MS-Off Ver
    Excel 2002
    Posts
    9

    Re: Basic Script to separate data using variable input into Excel .csv

    I have a screenshot of what I get when I run this with the marked paragraphs ommitted, but cannot post a picture for some reason, hopefully this works:
    HTML Code: 
    Reply With QuoteRegister To Reply
  3. 10-09-2013, 07:17 PM #3
    jimmyj2000
    jimmyj2000 is offline
    Registered User
    Join Date
    10-04-2013
    Location
    Michigan
    MS-Off Ver
    Excel 2002
    Posts
    9

    Re: Basic Script to separate data using variable input into Excel .csv

    Well, I think I'm getting closer after hours of reading, but I think I still have an issue in the block labeled #2. Any pros have any ideas?


    Sub Main 


'xl Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim count As Integer


'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim fs As Object 
Dim DimID As String 
Dim ReportDim As String
Dim CheckDim As String

Dim Cavity As String                                                 ‘start block 1
Dim myValue As String 
Dim message, title, defaultValue As String 

message = "Cavity" 
title = "cavity" 
defaultValue = "1" 
myValue = InputBox(message, title, defaultValue)
If myValue = "" Then myValue = defaultValue           ‘end block 1

'Check To see If results file exists
FilePath = "C:\Excel PC DMIS\3K170 B2A\"
Set fs = CreateObject("Scripting.FileSystemObject") 
ResFileExists = fs.fileexists(FilePath & Part.partname & ".xls")


'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbooks = xlapp.Workbooks
If ResFileExists = False Then
    TempFilename = FilePath & "Loop Template.xls"
Else
    TempFilename = FilePath & Part.partname & ".xls"
End If
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
'Set xlSheet = xlWorkbook.Worksheets("Sheet1")           ‘start block 2

Dim sh As Worksheets, flg As Boolean
For Each sh In Worksheets
     If sh.Name = myValue Then flg = True: Exit For 
Next

If flg = False Then 
   Sheets.Add.Name = myValue
End If

Set xlSheet = xlWorkbook.Worksheets(myValue)      ‘end block 2


If ResFileExists = False Then
    RCount=6
    CCount=3
    xlSheet.Range("B1").Value = Part.PartName
    xlSheet.Range("A6").Value = Date() & " " & Time()
    xlSheet.Range("B6").Value = "Inspector Name"
    For Each Cmd In Cmds
        'Eliminate DATDEF's
        If Cmd.Type <> 1299 Then
            'Do Dimensions
            If Cmd.IsDimension Then
                If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                End If
                If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                    Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                    If CheckDim <> "" Then
                            ReportDim = CheckDim
                    End If
                    If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                        If DCmd.ID = "" Then
                                xlSheet.Cells(5,CCount).Value = DimID & "."& DCmd.AxisLetter
                        Else
                                xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "M"
                        End If
                                xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                'Measured Or Deviation With check For True Position
      		        If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(6,CCount).Value = DCmd.Measured
		        Else
                                  xlSheet.Cells(6,CCount).Value = DCmd.Deviation
		        End If
                                'Add Min/Max For Profile dimensions
                                If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  CCount=CCount+1
                                  xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Max"
                                  xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                  xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                  xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                  xlSheet.Cells(6,CCount).Value = DCmd.Max
                                  CCount=CCount+1
                                  xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Min"
                                  xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                  xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                  xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                  xlSheet.Cells(6,CCount).Value = DCmd.Min
                                End If
                                CCount=CCount+1
                    End If
                End If
            End If
            'Do GDT
            If Cmd.Type = 184 Then
                  ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                  If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                        xlSheet.Cells(5,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                        xlSheet.Cells(2,CCount).Value = "0"
                        xlSheet.Cells(3,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                        xlSheet.Cells(4,CCount).Value = "0"
                        xlSheet.Cells(6,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
                        CCount=CCount+1
                  End If
            End If
        End If
    Next Cmd


Else

'Find first Open column.
RCount=6
Found=0
Do Until Found = 1
RCount = RCount + 1
If xlSheet.Cells(RCount,1).Value = "" Then
Found=1
End If
Loop

xlSheet.Cells(RCount,1).Value = Date() & " " & Time()
xlSheet.Cells(RCount,2).Value= "Inspector Name"

'Fill In measured data
CCount = 3
    For Each Cmd In Cmds
        'Eliminate DATDEF's
        If Cmd.Type <> 1299 Then
            'Do Dimensions
            If Cmd.IsDimension Then
                If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                End If
                If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                    Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                    If CheckDim <> "" Then
                            ReportDim = CheckDim
                    End If
                    If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                'Measured Or Deviation With check For True Position
      	                    If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Measured
		        Else
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation
		        End If
                                'Add Min/Max For Profile dimensions
                                If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  CCount=CCount+1
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Max
                                  CCount=CCount+1
                                  xlSheet.Cells(RCount,CCount).Value = DCmd.Min
                                End If
                       Ccount=Ccount+1
                    End If
                End If
            End If
            'Do GDT
            If Cmd.Type = 184 Then
                  ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                  If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                        xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                        xlSheet.Cells(RCount,CCount).Value = "0"
                        xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                        xlSheet.Cells(RCount,CCount).Value = "0"
                        xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
                        CCount=CCount+1
                  End If
            End If
        End If
    Next Cmd
End If


'Save And Cleanup
Set xlSheet = Nothing 
SaveName = FilePath & Part.partname & ".xls"
If ResFileExists = False Then
xlWorkBook.SaveAs SaveName
Else
xlWorkBook.Save
End If
xlWorkbook.Close
Set xlWorkbook = Nothing 
xlWorkbooks.Close 
Set xlWorkbooks = Nothing 
xlApp.Quit 
Set xlApp = Nothing

LabelEnd:

End Sub
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] VBA Script to run from separate file instead of current excel workbook
    By chouston in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 03-12-2013, 07:16 PM
  2. Macro/Script for Moving Groups of Data in to Separate Columns
    By JustinSxcel in forum Excel Programming / VBA / Macros
    Replies: 23
    Last Post: 07-05-2012, 01:56 AM
  3. variable in to input data into variable named sheet and if does not exist create
    By rwhidden in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 07-30-2011, 12:08 AM
  4. PAUSE EXCEL MACRO FOR INPUT OF DATA VARIABLE
    By lynne b in forum Excel General
    Replies: 2
    Last Post: 06-09-2006, 07:25 PM
  5. Basic EXCEL VBA - input to cell help
    By mattcasim in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 02-07-2005, 05:32 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1