H
Himansu
Hello eveyone,
I'm a novice with VB so please bear with me.
This is what I need to automate:
1. I import two fixed width files into excel. The format of the
file will vary each time.
2. I do some formating on each.
3. Combine them into one workbook.
4. I tried variuos ways to automate this, but I'm having
some problems. Here the code to the macro. Hopefully
someone can assist me. Any help will be greatly appecitaed.
----------------------------------------------------------------------------
-------------------------------------
Sub client()
'
' client Macro
' Macro recorded 8/23/2005 by hamin
'
Dim CellMatrixFile As String ' cell matrix file form alpha
Dim DeptMatrixFile As String ' department matrix file from alpha
Dim SaveAsFile As String ' save file name after all functions are
_
complete
Dim myLastRow As Long
Dim myLastCol As Long
Dim dummyRng As Range
Dim wks As Worksheet
Application.DisplayAlerts = False ' IS THIS NEEDED?
Set OldSpreadSheet = ActiveWindow.ActiveSheet
CellMatrixFile = Application.GetOpenFilename("Matrix Files,*.matrix")
If CellMatrixFile <> "False" Then
Workbooks.OpenText Filename:=CellMatrixFile, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=
_
Array(Array(0, 2), Array(10, 1), Array(20, 1), Array(30, 1),
Array(40, 1) _
, Array(50, 1), Array(60, 1), Array(70, 1), Array(80, 1), Array(90,
1) _
, Array(100, 1), Array(110, 1), Array(120, 1), Array(130, 1),
Array(140, 1) _
, Array(150, 1), Array(160, 1), Array(170, 1), Array(180, 1),
Array(190, 1) _
, Array(200, 1), Array(210, 1), Array(220, 1), Array(230, 1),
Array(240, 1))
Else
Exit Sub
End If
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Lots:"
'Range("C1").Select
'ActiveCell.FormulaR1C1 = "Lot 2"
'Range("D1").Select
'ActiveCell.FormulaR1C1 = "Lot 3"
Range("A1").Select
'Range("D1").Activate
Selection.Font.Bold = True
Range("A11").Select
Selection.NumberFormat = "@"
ActiveCell.FormulaR1C1 = "Total:"
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummnyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhile, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Cloumn
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
Range("B11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-8]C:R[-2]C)"
Range("B11").Select
Selection.Copy
Range("C11").Select
ActiveSheet.Paste
Range("D11").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
'ActiveCell.FormulaR1C1 = ""
'Range("A1").Select
ActiveWindow.Zoom = 85
ActiveSheet.Select
Sheets.Add
ActiveSheet.Select
ActiveSheet.Move Before:=Sheets(1)
Sheets("Sheet1").Select
DeptMatrixFile = Application.GetOpenFilename("Matrix Files,*.matrix")
If DeptMatrixFile <> "False" Then
Workbooks.OpenText Filename:=DeptMatrixFile, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=
_
Array(Array(0, 2), Array(10, 1), Array(20, 1), Array(30, 1),
Array(40, 1))
Else
Exit Sub
End If
Cells.Select
Selection.Copy
Windows.Application.CellMatrixFile.ActiveSheet
ActiveSheet.Paste
Sheets("Sheet1").Select
Windows.Application.OldSpreadSheet.Activate
ActiveSheet.Select
Application.CutCopyMode = False
Windows.Application.Book1.ActiveSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Name = DeptMatrixFile
Range("A1").Select
ActiveWindow.Zoom = 85
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("B1").Select
ActiveCell.FormulaR1C1 = "Lot 1"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Lot 2"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Lot 3"
Range("A11").Select
Selection.Font.Bold = True
Range("A8").Select
Selection.NumberFormat = "@"
ActiveCell.FormulaR1C1 = "Total:"
Range("B8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C:R[-2]C)"
Range("B8").Select
Selection.Copy
Range("C8").Select
ActiveSheet.Paste
Range("D8").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
Windows.Application.Book1.ActiveSheet.Select
SaveAsFile =
Application.GetSaveAsFilename("Client_Cell_Dept_Counts.xls", "Excel files,
*.xls", _
1, "Select your folder and filename")
If SaveAsFile <> "False" Then
ActiveWorkbook.SaveAs SaveAsFile, FileFormat:=xlNormal,
Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False,
CreateBackup:=False
End If
ActiveWindow.Activate
ActiveWindow.Close
ActiveWindow.Close
End Sub
I'm a novice with VB so please bear with me.
This is what I need to automate:
1. I import two fixed width files into excel. The format of the
file will vary each time.
2. I do some formating on each.
3. Combine them into one workbook.
4. I tried variuos ways to automate this, but I'm having
some problems. Here the code to the macro. Hopefully
someone can assist me. Any help will be greatly appecitaed.
----------------------------------------------------------------------------
-------------------------------------
Sub client()
'
' client Macro
' Macro recorded 8/23/2005 by hamin
'
Dim CellMatrixFile As String ' cell matrix file form alpha
Dim DeptMatrixFile As String ' department matrix file from alpha
Dim SaveAsFile As String ' save file name after all functions are
_
complete
Dim myLastRow As Long
Dim myLastCol As Long
Dim dummyRng As Range
Dim wks As Worksheet
Application.DisplayAlerts = False ' IS THIS NEEDED?
Set OldSpreadSheet = ActiveWindow.ActiveSheet
CellMatrixFile = Application.GetOpenFilename("Matrix Files,*.matrix")
If CellMatrixFile <> "False" Then
Workbooks.OpenText Filename:=CellMatrixFile, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=
_
Array(Array(0, 2), Array(10, 1), Array(20, 1), Array(30, 1),
Array(40, 1) _
, Array(50, 1), Array(60, 1), Array(70, 1), Array(80, 1), Array(90,
1) _
, Array(100, 1), Array(110, 1), Array(120, 1), Array(130, 1),
Array(140, 1) _
, Array(150, 1), Array(160, 1), Array(170, 1), Array(180, 1),
Array(190, 1) _
, Array(200, 1), Array(210, 1), Array(220, 1), Array(230, 1),
Array(240, 1))
Else
Exit Sub
End If
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Lots:"
'Range("C1").Select
'ActiveCell.FormulaR1C1 = "Lot 2"
'Range("D1").Select
'ActiveCell.FormulaR1C1 = "Lot 3"
Range("A1").Select
'Range("D1").Activate
Selection.Font.Bold = True
Range("A11").Select
Selection.NumberFormat = "@"
ActiveCell.FormulaR1C1 = "Total:"
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummnyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhile, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Cloumn
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
Range("B11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-8]C:R[-2]C)"
Range("B11").Select
Selection.Copy
Range("C11").Select
ActiveSheet.Paste
Range("D11").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
'ActiveCell.FormulaR1C1 = ""
'Range("A1").Select
ActiveWindow.Zoom = 85
ActiveSheet.Select
Sheets.Add
ActiveSheet.Select
ActiveSheet.Move Before:=Sheets(1)
Sheets("Sheet1").Select
DeptMatrixFile = Application.GetOpenFilename("Matrix Files,*.matrix")
If DeptMatrixFile <> "False" Then
Workbooks.OpenText Filename:=DeptMatrixFile, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=
_
Array(Array(0, 2), Array(10, 1), Array(20, 1), Array(30, 1),
Array(40, 1))
Else
Exit Sub
End If
Cells.Select
Selection.Copy
Windows.Application.CellMatrixFile.ActiveSheet
ActiveSheet.Paste
Sheets("Sheet1").Select
Windows.Application.OldSpreadSheet.Activate
ActiveSheet.Select
Application.CutCopyMode = False
Windows.Application.Book1.ActiveSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Name = DeptMatrixFile
Range("A1").Select
ActiveWindow.Zoom = 85
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("B1").Select
ActiveCell.FormulaR1C1 = "Lot 1"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Lot 2"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Lot 3"
Range("A11").Select
Selection.Font.Bold = True
Range("A8").Select
Selection.NumberFormat = "@"
ActiveCell.FormulaR1C1 = "Total:"
Range("B8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C:R[-2]C)"
Range("B8").Select
Selection.Copy
Range("C8").Select
ActiveSheet.Paste
Range("D8").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
Windows.Application.Book1.ActiveSheet.Select
SaveAsFile =
Application.GetSaveAsFilename("Client_Cell_Dept_Counts.xls", "Excel files,
*.xls", _
1, "Select your folder and filename")
If SaveAsFile <> "False" Then
ActiveWorkbook.SaveAs SaveAsFile, FileFormat:=xlNormal,
Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False,
CreateBackup:=False
End If
ActiveWindow.Activate
ActiveWindow.Close
ActiveWindow.Close
End Sub