Sub Totals with multiple rows and columns

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("A1:D1").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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top