Hello all!
I have a CSV that I have imported into Excel. The column headers are always named the same thing, but not always in the same place. I am attempting to create a new workbook from the CSV Workbook. The existing code is below.
[vba]
Option Explicit
Option Base 1
Public nBook As Workbook
Public oBook As String
Public iBook As String
Function findHeader(fHead)
Dim i As Integer
i = 1
Do Until ActiveSheet.Cells(1, i).Value = fHead
i = i + 1
Loop
findHeader = i
End Function
Public Sub loseDupes()
Workbooks(iBook).Worksheets(1).Range(Cells(7, 1), Cells(7, 5)) = _
Workbooks(oBook).Worksheets(1).Range(Cells(7, 1), Cells(7, 5))
End Sub
Public Sub newBook()
Set nBook = Workbooks.Add
Dim fName As String
fName = Application.GetSaveAsFilename(fileFilter:="Excel files (*.xls), *.xls")
nBook.SaveAs Filename:=fName
iBook = nBook.Name
End Sub
Public Sub assessment1()
Dim hCols(8) As Variant
oBook = ActiveWorkbook.Name
Dim n As Integer
For n = 1 To Range("A1").CurrentRegion.Columns.Count
hCols(n) = ActiveSheet.Cells(1, n).Value
Next n
Call newBook
Range("A1:F1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection.Interior
.ColorIndex = 47
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
For n = 2 To 5
Range(Cells(n, 1), Cells(n, 2)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range(Cells(n, 1), Cells(n, 6)).Select
With Selection.Interior
.ColorIndex = 19
.Pattern = xlSolid
End With
Select Case n
Case 2
ActiveSheet.Cells(n, 1).Value = "Trainer"
Case 3
ActiveSheet.Cells(n, 1).Value = "Location"
Case 4
ActiveSheet.Cells(n, 1).Value = "Date"
Case 5
ActiveSheet.Cells(n, 1).Value = "Average Assessment Score"
End Select
Next n
For n = 1 To 6
ActiveSheet.Cells(6, n).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.ColorIndex = 47
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Select Case hCols(n)
Case "Student Last Name"
hCols(n) = "Last Name"
ActiveCell.Value = hCols(n)
Case "Student First Name"
hCols(n) = "First Name"
ActiveCell.Value = hCols(n)
Case "Student Xid"
hCols(n) = "Student XID"
ActiveCell.Value = hCols(n)
Case "Assessment Score"
hCols(n) = "Score"
ActiveCell.Value = hCols(n)
Case "Date Taken"
hCols(n) = "Date"
ActiveCell.Value = hCols(n)
Case "Pass/Fail or Evaluation"
hCols(n) = "Pass / Fail"
ActiveCell.Value = hCols(n)
End Select
Next n
Range("A1").CurrentRegion.Select
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ActiveSheet.Name = "Summary"
Windows(oBook).Activate
Call loseDupes
End Sub
[/vba]
What is happening is the code is running fine until it gets to loseDupes. The new workbook is created, the save as dialog box comes up, and the formatting gets done. And then it hangs. With the code above, I'm getting an "Application or user-defined error" (PC Load Letter? The ****'s that mean?). I'm really having an issue with getting the unique records from the CSV workbook, to the newly created workbook. Upon entering debug mode, all my variables look right, and all the files I'm pointing to exist and are open. Please help.
Reply With Quote
