![]() |
Sub Totals with multiple rows and columns
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 Befo=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_Co unts.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 ---------------------------------------------------------------------------- -------------------------------------------------------------------------- |
All times are GMT +1. The time now is 12:03 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com