lneilson
09-12-2008, 06:19 AM
Hi all
this is my most current problem,my pages currently are 1 , 2, and 3
the text file I'm down loading is a daily log the data is vertical the data is
then copied to page 2 is transposed so it is horizonal and then manipulated and copied to page 3 also horizonal and the problem is when I get to row 245 that is the limit of the other 2 pages so how do stop the workbook there and start a new one with the data coming from page 1 row 246 on down and everything would be fine except I need to add the last 8 columns of data from the book one and add it to last 8 columns of
book 2 . Or continue on in book 1 but from page 1 row 246 would go to page 4 then page 5 and would still need the last 8 columns of page 3 added to the last 8 columns of page 5
thank you
lneilson
Reformatted code to 80 columns to prevent side-scrolling.
~Oorang
Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlWB2 As Excel.Workbook
Dim lastrow As Long
Dim LR As Long
Dim GO As Range
Dim cl As Range
Dim lngColumn As Long
Dim LC As Integer
Dim NC As Integer
Dim lngSum As Integer
Dim LastColumn As Integer
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWB1 = xlApp.Workbooks.Open("G:\data5.xls")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;G:\data5.txt", _
Destination:=Range("A1"))
.Name = "data 5"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 3, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(5, 13, 4, 5, 5, 5)
.Refresh BackgroundQuery:=False
Columns("B:B").Select
Selection.NumberFormat = "m/d/yy"
End With
LR = Range("C" & Rows.Count).End(xlUp).Row
Range("C1:G" & LR).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWindow.ScrollColumn = 179
Dim r As Long
For Each cl In Worksheets("SHEET2").UsedRange
If cl.Value = 0 Then
r = 10
Else
r = cl.Value
End If
With Worksheets("SHEET3").Cells(r, cl.Column)
.Value = CStr(Val(.Value) + 1)
End With
Next cl
Sheets("Sheet3").Select
Sheets("Sheet1").Select
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:a" & LR).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A41").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
Sheets("Sheet1").Select
LR = Range("B" & Rows.Count).End(xlUp).Row
Range("B1:b" & LR).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A42").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
Rows("42:42").Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yy"
Sheets("Sheet3").Select
Dim blnFound As Boolean
Dim intCounter As Integer
Dim intColCount As Integer
Dim intColLast As Integer
Dim lngRowCount As Long
Dim lngRowLast As Long
Dim lngRowTemp As Long
intColCount = Columns.Count
lngRowCount = Columns(1).Rows.Count
blnFound = False
'Get the last used column.
'Start looking in the last column.
For intCounter = intColCount To 1 Step -1
If Columns(intCounter).End(xlDown).Row < lngRowCount Then
intColLast = intCounter
blnFound = True
Exit For
ElseIf Columns(intCounter).End(xlDown).Row = lngRowCount Then
If Columns(intCounter).End(xlDown).Value <> vbNullString Then
intColLast = intCounter
blnFound = True
Exit For
End If
End If
Next intCounter
'Get the last used row within the collection of used columns.
lngRowLast = 1
For intCounter = 1 To intColLast
lngRowTemp = Columns(intCounter).Cells(lngRowCount, 1).End(xlUp).Row
If lngRowTemp > lngRowLast Then
lngRowLast = lngRowTemp - 2
End If
Next intCounter
For intCounter = 1 To lngRowLast
Columns(intColLast + 1).Cells(intCounter, 1).Formula = "=sum(A" & _
intCounter & ":" & Columns(intColLast).Cells(intCounter, 1).Address & _
")"
Next intCounter
Sheets("Sheet3").Select
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Cells(40, "A").Resize(, LastCol).Formula = "=SUM(A1:A39)"
Cells(1, LastCol + 1).Select
End With
Sheets("Sheet3").Select
'Get the last used row within the collection of used columns.
lngRowLast = Cells(Rows.Count, "A").End(xlUp).Row
'Get the last used column.
intColLast = Cells(lngRowLast, Columns.Count).End(xlToLeft).Column
'adjust to remove footer rows
lngRowLast = lngRowLast - 2
Cells(1, intColLast + 1).Resize(lngRowLast).FormulaR1C1 = "=SUM(RC1:RC" & _
intColLast & ")"
Cells(lngRowLast + 1, intColLast + 2).Resize(, 7).Value = Array("Sun.", _
"Mon.", "Tue.", "Wed.", "Thu.", "Fri.", "Sat.", "Sun.")
Cells(1, intColLast + 2).Resize(lngRowLast, 7).FormulaR1C1 = "=SUMIF(R" & _
lngRowLast + 1 & "C1:R" & lngRowLast + 1 & "C" & intColLast & ",R" & _
lngRowLast + 1 & "C," & "RC1:RC" & intColLast & ")"
Sheets("Sheet3").Select
End Sub
this is my most current problem,my pages currently are 1 , 2, and 3
the text file I'm down loading is a daily log the data is vertical the data is
then copied to page 2 is transposed so it is horizonal and then manipulated and copied to page 3 also horizonal and the problem is when I get to row 245 that is the limit of the other 2 pages so how do stop the workbook there and start a new one with the data coming from page 1 row 246 on down and everything would be fine except I need to add the last 8 columns of data from the book one and add it to last 8 columns of
book 2 . Or continue on in book 1 but from page 1 row 246 would go to page 4 then page 5 and would still need the last 8 columns of page 3 added to the last 8 columns of page 5
thank you
lneilson
Reformatted code to 80 columns to prevent side-scrolling.
~Oorang
Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlWB2 As Excel.Workbook
Dim lastrow As Long
Dim LR As Long
Dim GO As Range
Dim cl As Range
Dim lngColumn As Long
Dim LC As Integer
Dim NC As Integer
Dim lngSum As Integer
Dim LastColumn As Integer
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWB1 = xlApp.Workbooks.Open("G:\data5.xls")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;G:\data5.txt", _
Destination:=Range("A1"))
.Name = "data 5"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 3, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(5, 13, 4, 5, 5, 5)
.Refresh BackgroundQuery:=False
Columns("B:B").Select
Selection.NumberFormat = "m/d/yy"
End With
LR = Range("C" & Rows.Count).End(xlUp).Row
Range("C1:G" & LR).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWindow.ScrollColumn = 179
Dim r As Long
For Each cl In Worksheets("SHEET2").UsedRange
If cl.Value = 0 Then
r = 10
Else
r = cl.Value
End If
With Worksheets("SHEET3").Cells(r, cl.Column)
.Value = CStr(Val(.Value) + 1)
End With
Next cl
Sheets("Sheet3").Select
Sheets("Sheet1").Select
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:a" & LR).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A41").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
Sheets("Sheet1").Select
LR = Range("B" & Rows.Count).End(xlUp).Row
Range("B1:b" & LR).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A42").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
Rows("42:42").Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yy"
Sheets("Sheet3").Select
Dim blnFound As Boolean
Dim intCounter As Integer
Dim intColCount As Integer
Dim intColLast As Integer
Dim lngRowCount As Long
Dim lngRowLast As Long
Dim lngRowTemp As Long
intColCount = Columns.Count
lngRowCount = Columns(1).Rows.Count
blnFound = False
'Get the last used column.
'Start looking in the last column.
For intCounter = intColCount To 1 Step -1
If Columns(intCounter).End(xlDown).Row < lngRowCount Then
intColLast = intCounter
blnFound = True
Exit For
ElseIf Columns(intCounter).End(xlDown).Row = lngRowCount Then
If Columns(intCounter).End(xlDown).Value <> vbNullString Then
intColLast = intCounter
blnFound = True
Exit For
End If
End If
Next intCounter
'Get the last used row within the collection of used columns.
lngRowLast = 1
For intCounter = 1 To intColLast
lngRowTemp = Columns(intCounter).Cells(lngRowCount, 1).End(xlUp).Row
If lngRowTemp > lngRowLast Then
lngRowLast = lngRowTemp - 2
End If
Next intCounter
For intCounter = 1 To lngRowLast
Columns(intColLast + 1).Cells(intCounter, 1).Formula = "=sum(A" & _
intCounter & ":" & Columns(intColLast).Cells(intCounter, 1).Address & _
")"
Next intCounter
Sheets("Sheet3").Select
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Cells(40, "A").Resize(, LastCol).Formula = "=SUM(A1:A39)"
Cells(1, LastCol + 1).Select
End With
Sheets("Sheet3").Select
'Get the last used row within the collection of used columns.
lngRowLast = Cells(Rows.Count, "A").End(xlUp).Row
'Get the last used column.
intColLast = Cells(lngRowLast, Columns.Count).End(xlToLeft).Column
'adjust to remove footer rows
lngRowLast = lngRowLast - 2
Cells(1, intColLast + 1).Resize(lngRowLast).FormulaR1C1 = "=SUM(RC1:RC" & _
intColLast & ")"
Cells(lngRowLast + 1, intColLast + 2).Resize(, 7).Value = Array("Sun.", _
"Mon.", "Tue.", "Wed.", "Thu.", "Fri.", "Sat.", "Sun.")
Cells(1, intColLast + 2).Resize(lngRowLast, 7).FormulaR1C1 = "=SUMIF(R" & _
lngRowLast + 1 & "C1:R" & lngRowLast + 1 & "C" & intColLast & ",R" & _
lngRowLast + 1 & "C," & "RC1:RC" & intColLast & ")"
Sheets("Sheet3").Select
End Sub