Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help with loop
Hello, i hope that someone can help me, here is my code, i am not
understanding where i need to put the loop inorder to preserve what i have in my .Find and then copy it over to the other sheet. I was thinking about using an array for the [arrSection and arrDestSection], i hope that i am on the right track. How do i save that data from the the .Find and then at the end, enter it into the formatted sheet, using each part of the arrDestSection? Hope that i have explained it properly. My sheets are set up like: sSheet /// A2:F8 would have the F column value being 'Secondary', then A9:F20 could have the F column as Primary and the last A21:F30 could be 'Non-Production. I copy what is in the rows, minus the F column. a - through - f column A2 f column Secondary .... A8 f column Secondary .... A9 f column Primary A20 f column Primary .... A21 f column Non-Production .... A30 f column Non-Production dSheet /// set up as a template with specific formatting and formulas. A8 is always the first empty row, but i have code to find that 1st empty row and if there is not enough room it adds rows, preserving the format, lets say it goes to A45 with a value of "Total Primary Tasks". The second section of the sheet could be A50, with a value of "Total Secondary Tasks", starts from there, and i want it to do the same as above, finding the first empty row available after the cell that contains the value "Secondary Tasks". and the same with the third section of the sheet which would contain the "Non-Production Tasks" and the "Total Non-Production Tasks" rows. A8- always the first available row for "Primary Tasks" .... A15 Contains the value "Total Primary Tasks" A18 contains the value "Secondary Tasks" .... A21 contains the value "Total Secondary Tasks" A23 contains the value "Non-Production Tasks" .... A26 contains the value "Total Non-Production Tasks" Overall, i am trying to find the section values in sSheet, and copy them over the corresponding section in the dSheet. Here is what i have so far, with much help from this forum, hope that someone can give me more insight as to what to do next, i am fairly new and need lots of help...thanks so much. ANy help would really be appreciated. Keri~ The code below works great for the first section "Primary" Option Explicit Sub SendData() Dim FindFirst As Range Dim FindLast As Range Dim searchRange As Range Dim copyRange As Range Dim WhatToFind As String Dim DestCell As Range Dim FinalRow As Long Dim sBook As Workbook Dim sSheet As Worksheet Dim dBook As Workbook Dim dSheet As Worksheet Dim theName As String Dim FoundCell As Range Dim strPri As String Dim fAddr Dim Row1 As Integer Dim Row2 As Integer Dim NumRows As Integer Dim RowCntr As Integer Dim RowsNeeded As Integer Dim arrSection() As String Dim i As Integer Dim arrDestSection() As String Dim strGroup As String Dim x As Integer With Application .DisplayAlerts = False End With Erase arrSection Erase arrDestSection Set sBook = ThisWorkbook 'or ActiveWorkbook ??? Set dBook = Workbooks.Open("E:\Excel\Portlet & Global Dev together TEST\DesBook.xls") Set dSheet = dBook.Sheets("Template") ' ReDim arrSection(2) ' arrSection(0) = "Primary" ' arrSection(1) = "Secondary" ' arrSection(2) = "Non-Production" For Each sSheet In sBook.Worksheets sSheet.Activate If Cells(1, 1).Value = vbNullString Then Exit Sub End If With ActiveSheet FinalRow = Cells(Rows.Count, 6).End(xlUp).Row ' For i = LBound(arrSection) To UBound(arrSection) ' WhatToFind = (arrSection(i)) WhatToFind = "Primary" Set searchRange = .Range("F2:F" & FinalRow) With searchRange Set FindFirst = .Find(What:=WhatToFind, _ LookIn:=xlValues, LookAt:=xlWhole, _ after:=.Cells(.Cells.Count), _ SearchDirection:=xlNext) Set FindFirst = FindFirst.Offset(0, -5) Debug.Print FindFirst.Address Row1 = FindFirst.Row Set FindLast = .Find(What:=WhatToFind, _ LookIn:=xlValues, LookAt:=xlWhole, _ after:=.Cells(1), SearchDirection:=xlPrevious) Set FindLast = FindLast.Offset(0, -1) Debug.Print FindLast.Address Row2 = FindLast.Row NumRows = Row1 - Row2 Debug.Print "The FIND row count: " & NumRows End With ' Next i End With If FindFirst Is Nothing Then MsgBox "Nothing found" Exit Sub End If Set copyRange = Range(FindFirst, FindLast) Debug.Print "the copy range: "; copyRange.Address theName = sSheet.Name With dBook.Worksheets dSheet.Copy after:=.Item(.Count) ActiveSheet.Name = theName ' ReDim arrDestSection(2) ' arrDestSection(0) = "Total Primary Tasks" ' arrDestSection(1) = "Total Secondary" ' arrDestSection(2) = "Total Non-Production Hours" ' For x = LBound(arrDestSection) To UBound(arrDestSection) ' strGroup = (arrDestSection(x)) strGroup = "Total Primary Tasks" Set FoundCell = Cells.Find(strGroup, _ LookIn:=xlValues, LookAt:=xlWhole) Debug.Print FoundCell.Address ' Next x Debug.Print FoundCell.Address If Not FoundCell Is Nothing Then fAddr = FoundCell.Address FoundCell.Select If IsEmpty(ActiveCell) = False Then 'MsgBox "not empty" ActiveCell.Offset(-2, 0).Select If IsEmpty(ActiveCell) = False Then Call InsertRowsAndFillFormulas_caller End If ' //the loop for finding an empty cell to place everything.../////////////// RowCntr = 1 Do If IsEmpty(ActiveCell) = True Then ActiveCell.Offset(-1, 0).Select RowCntr = RowCntr + 1 End If Loop Until IsEmpty(ActiveCell) = False Debug.Print "the Empty rows in sheet: " & RowCntr End If Else MsgBox "Cannot find [Correct] String" End If ActiveCell.Offset(1, 0).Select RowsNeeded = Abs(NumRows) - RowCntr RowsNeeded = RowsNeeded + 2 Debug.Print "Need: " & RowsNeeded & " Rows" MsgBox "You need " & RowsNeeded & " more Rows added to sheet" If Not NumRows = RowCntr Then InsertRowsAndFillFormulas (RowsNeeded) End If End With Set DestCell = ActiveCell Debug.Print DestCell.Address copyRange.Copy Destination:=DestCell Next sSheet With Application .DisplayAlerts = True End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
For Each ... Next loop - need to reference the loop variable | Excel Programming | |||
Advancing outer Loop Based on criteria of inner loop | Excel Programming | |||
Loop Function unable to loop | Excel Programming | |||
Problem adding charts using Do-Loop Until loop | Excel Programming | |||
HELP!!!! Can't stop a loop (NOT an infinite loop) | Excel Programming |