Add value labels

 

Download as .sbs Shows as plain text

 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
'Begin Description
'Purpose: To assign value labels of format mmm yyyy (eg Feb 1997) to a numeric variable 
'Assumptions: The numeric variable is in the data editor and contains positive integers
'Inputs: 5 parameters are required, 1) varname, 2)starting month, 3)starting year, 4)direction (1 means
'		forward and -1 means backward) and 5)number of years.
'		
'		If you want to run the script by itself (i.e. NOT call it from a syntax file),
'		a line of the following form is used in the Main Sub of this script
'		strParam="month,1,1990,-1,10"
'		
'		If you want to call the script from a syntax file, a line of the following type is 
'		used in the syntax file:
'		SCRIPT file="c:\\program files\\spss\\scripts\\AddValueLabels.sbs" ("month,7,1998,-1,10").
'				
'Return Values: none
'Author: Raynald Levesque rlevesque@videotron.ca
'Date:   April 24, 1999
'End Description

Option Explicit
Public strParam As String, intMoNumber As Integer, intYear As Variant, intDelta As Integer
Public strVarName As String, intNumberYears As Integer, StrErr As String

Sub Main
	'Error handler
	StrErr = "Following error occured:"
	On Error GoTo ErrLoad

	strParam = objSpssApp.ScriptParameter(0)
	
	'Uncomment next line if Script is not called from syntax, modify the 5 parameters to suit your needs.
	'strParam="trial,2,1992,-1,5"
	ParseInput(strParam)
	StrErr = "Error while validating input string:"
	
	'Validate input values (future improvement: could verify that strVarName exists)
	If Len(strVarName)>8 Then Err.Raise Number:=1, Description:="Invalid Variable Name"
	If intMoNumber>12 Or intMoNumber<1 Then Err.Raise Number:=1, Description:="Invalid Initial month!"
	If intDelta<>1 And intDelta<>-1 Then Err.Raise Number:=1, Description:="4th parameter must be 1 or -1!"
	If intNumberYears<1 Or intYear<1 Then Err.Raise Number:=1, Description:="3rd and 5th parameters must be positive integers!"
	
	AssignLabels
	Exit Sub
	
	ErrLoad:
	MsgBox StrErr & vbCr & Err.Description, vbExclamation, "Error " & Err
		'display warning for the user
	Debug.Print StrErr & vbCr & "Error " & Err
		'for the record
	Exit Sub
End Sub


Sub AssignLabels
'Asign Labels
StrErr = "Error while assigning Labels:"

	Dim strCommand As String, strMoNames(12) As String, intCount As Integer
	Dim intCountYear As Integer, intMonth As Integer
	
		strMoNames(1)="Jan"
		strMoNames(2)="Feb"
		strMoNames(3)="Mar"
		strMoNames(4)="Apr"
		strMoNames(5)="May"
		strMoNames(6)="Jun"
		strMoNames(7)="Jul"
		strMoNames(8)="Aug"
		strMoNames(9)="Sep"
		strMoNames(10)="Oct"
		strMoNames(11)="Nov"
		strMoNames(12)="Dec"
	
	strCommand = "VALUE LABELS " &strVarName &" 1 " & Chr$(34)& strMoNames(intMoNumber) & " " & intYear& Chr$(34) & " "
	intCount = 2
	intMoNumber = intMoNumber + intDelta
	
	For intCountYear=1 To intNumberYears
		For intMonth=1 To 12
			'Check if we are crossing a year
			If intMoNumber > 12 And intDelta >0 Then 		
				'need to go to Jan of following year
				IntMoNumber=1
				intYear= intYear + intDelta
			ElseIf intMoNumber < 1 And intDelta <0 Then		
				'need to go to Dec of preceeding year
				IntMoNumber= 12
				intYear= intYear + intDelta
			End If

			strCommand = strCommand & intCount & " " & Chr$(34)& strMoNames(intMoNumber) & " " & intYear & Chr$(34) & " "
			intCount=intCount+1
			intMoNumber=intMoNumber + intDelta
		Next intMonth
	Next intCountYear
	strCommand = strCommand & "."
	objSpssApp.ExecuteCommands strCommand, False

End Sub


Sub ParseInput(strInput As String)
' Parse the input string into its 5 components
Dim intTemp1 As Integer, intTemp2 As Integer, strValue As String
StrErr = "Error while parsing input:"
		
	intTemp1	=InStr(strInput,",")
	strVarName	=Mid(strInput,1,intTemp1-1)
	
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intMoNumber	=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intYear		=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intDelta	=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intNumberYears=CInt(Mid(strInput,intTemp1+1,Len(strInput)-intTemp1))
End Sub
Related pages

...

Navigate from here