Hi,
I am having a problem with a tool I have made for occ sick.
To summarise you key in the emp number dates reasons, actions etc and it initially has a change script that displays the proposed output details in both the database codes and the descriptions the user would see.
E.g.
Cancer = 0100
In the display area it brings this through with the header 0 but knocks off the end 0
E.g.
010
The other field I have like this is action type
E.g. Sick note recieved = 001
This is just pulling through as 1, even the code is exactly the same and all the formating is the same.
This is then copied to the output tab where it is stored till all the entries are keyed, the next step is to turn the output file in to CSV.
When you run the create csv macro and view the csv file produced you can see it has removed the header 0 as well!
So in short, the spreadsheet macro is knocking off end 0 and the csv macro is knocking off the header 0.
This is my code for the change event which is what copies and looks up the values for the display area:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("iCLEAR")) Is Nothing Then
Select Case Range("Status").Value
Case 1
Range("OEMP") = Range("EMP")
Range("DEMP") = Range("NAME")
Range("DTYPE") = Range("TYPE")
Range("DABS") = Range("ABS")
Range("ABDEC1,ABDEC2") = Range("ABS")
Range("OSD,DSD") = Range("SD")
Range("DST,OST") = Range("ST")
Range("OED,DED") = Range("ED")
Range("DET,OET") = Range("ET")
Range("ODUR,DDUR") = Range("IDUR")
Range("OCAL,DCAL") = Range("ICAL")
Range("DACT") = Range("ACT")
Range("OTYPE") = Application.VLookup(Worksheets("INPUT").Range("DTYPE"), Worksheets("DATA").Range("VTYPE"), 2, False)
Range("OABS") = Range("CODEABS")
Range("OACT") = Application.VLookup(Worksheets("INPUT").Range("DACT"), Worksheets("DATA").Range("VACT"), 2, False)
Range("OCERT,DCERT") = Application.VLookup(Worksheets("INPUT").Range("ACT"), Worksheets("DATA").Range("VCERT"), 3, False)
If Range("ST,ET") = "" Then
Range("DST,OST") = "AM"
Range("DET,OET") = "PM"
End If
Case 0
Range("OCLEAR") = ""
End Select
End If
End Sub
This is the code I have slightly altered for my workbook, which Jerry BeauCaire wrote that creates my CSV file:
Option Explicit
Sub CreateCSV()
'Author: Jerry Beaucaire, ExcelForum.com
'Date: 10/8/2010
'Summary: Create a specifically formatted CSV file from activesheet
Dim cell As Long
Dim NR As Long
Dim wsData As Worksheet
Dim wsCSV As Worksheet
Dim SaveStr As String
Set wsData = Sheets("OUTPUT")
Set wsCSV = Worksheets.Add(After:=Sheets(Sheets.Count))
With wsData
wsCSV.Range("A1") = "EMP_ID"
.Range("EmpRng").Copy wsCSV.Range("A2")
wsCSV.Range("B1") = "TYPE_ID"
.Range("TYRng").Copy wsCSV.Range("B2")
wsCSV.Range("C1") = "ABSENT_ID"
.Range("ABSRng").Copy wsCSV.Range("C2")
wsCSV.Range("D1") = "START_DATE"
.Range("SDRng").Copy wsCSV.Range("D2")
wsCSV.Range("E1") = "START_TIME"
.Range("STRng").Copy wsCSV.Range("E2")
wsCSV.Range("F1") = "END_DATE"
.Range("EDRng").Copy wsCSV.Range("F2")
wsCSV.Range("G1") = "END_TIME"
.Range("ETRng").Copy wsCSV.Range("G2")
wsCSV.Range("H1") = "DURATION"
.Range("DRng").Copy wsCSV.Range("H2")
wsCSV.Range("I1") = "DUR_CAL_DAYS"
.Range("CALRng").Copy wsCSV.Range("I2")
wsCSV.Range("J1") = "ACTION_ID"
.Range("ACTRng").Copy wsCSV.Range("J2")
wsCSV.Range("K1") = "DESCRIPTION"
.Range("ADRng").Copy wsCSV.Range("K2")
wsCSV.Range("L1") = "CERTIFIED"
.Range("CertRng").Copy wsCSV.Range("L2")
End With
wsCSV.Move
ActiveSheet.Name = "OSP_CSV"
SaveStr = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
& Application.PathSeparator _
& ActiveSheet.Name _
& Environ("USERNAME") _
& " - " _
& Format(Now, " d-m-yy h.m AM/PM")
ActiveWorkbook.SaveAs Filename:=SaveStr & ".csv", FileFormat:=xlCSVWindows, CreateBackup:=False, local:=True
ActiveWorkbook.Close False
Worksheets("INPUT").Activate
End Sub
Bookmarks