View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Sam Wilson Sam Wilson is offline
external usenet poster
 
Posts: 523
Default Looping(Rookies)

You have this:

For x = 2 To 930
....
Set wb = Workbooks.Open(tbFile, True, True)


which tries to open the workbook in each loop. Try moving the line "Set wb =
Workbooks.Open(tbFile, True, True)" to before the loop.


Application.ScreenUpdating = False ' turn off the screen updating

' open the source workbook, read only
With ThisWorkbook.Worksheets("Duration Test")

.Range("B1").Formula = "File : " & tbFile.Value
.Range("B2").Formula = "Test Completed : " & FormatDateTime(Now())

.Range("A3").Formula = "ID"
.Range("B3").Formula = "Task"
.Range("C3").Formula = "Duration"
.Range("D3").Formula = "Start Date"
.Range("E3").Formula = "Finish Date"
' read data from the source workbook
.Range("A" & y).Formula = wb.Worksheets("Task_Table1").Range("A" &
x).Formula
.Range("B" & y).Formula = wb.Worksheets("Task_Table1").Range("B" &
x).Formula
.Range("C" & y).Formula = wb.Worksheets("Task_Table1").Range("E" &
x).Formula
.Range("D" & y).Formula = wb.Worksheets("Task_Table1").Range("C" &
x).Formula
.Range("E" & y).Formula = wb.Worksheets("Task_Table1").Range("D" &
x).Formula

End With

Set wb = Nothing
Application.ScreenUpdating = True ' turn on the screen updating
y = y + 1
ActiveSheet.Cells.Select
ActiveSheet.UsedRange.Columns.AutoFit

Set wb = Nothing ' free memory
Else
End If


"KK" wrote:

Private Sub cbFile_Click()

'returns your full file name.
File_Name = Application.GetOpenFilename("MS Excel Files (*.xls),*.xls")

'hence no len, no name...
If Len(File_Name) = 0 Then Exit Sub

tbFile.Value = File_Name

End Sub

Private Sub cbStart_Click()

Workbooks.Open (tbFile)

Dim x As Integer
Dim y As Integer
Dim z As String

y = 4
For x = 2 To 930

Sheets("Task_Table1").Select
Application.Goto Reference:="R" & x & "C13"

ActiveCell.FormulaR1C1 =
"=IF((LEFT(RC[-8],LEN(RC[-8])-4)+1)11,(IF(RC[-6]<""Yes"",(IF(RC[-3]<1,""YES"",""No"")),""No"")),""No"")"
z = ActiveCell.Value


If (z < "No") Then

Workbooks("Project_Analyzer_v2").Activate
Set wb = Workbooks.Open(tbFile, True, True)


Application.ScreenUpdating = False ' turn off the screen updating

' open the source workbook, read only
With ThisWorkbook.Worksheets("Duration Test")

.Range("B1").Formula = "File : " & tbFile.Value
.Range("B2").Formula = "Test Completed : " & FormatDateTime(Now())

.Range("A3").Formula = "ID"
.Range("B3").Formula = "Task"
.Range("C3").Formula = "Duration"
.Range("D3").Formula = "Start Date"
.Range("E3").Formula = "Finish Date"
' read data from the source workbook
.Range("A" & y).Formula = wb.Worksheets("Task_Table1").Range("A" &
x).Formula
.Range("B" & y).Formula = wb.Worksheets("Task_Table1").Range("B" &
x).Formula
.Range("C" & y).Formula = wb.Worksheets("Task_Table1").Range("E" &
x).Formula
.Range("D" & y).Formula = wb.Worksheets("Task_Table1").Range("C" &
x).Formula
.Range("E" & y).Formula = wb.Worksheets("Task_Table1").Range("D" &
x).Formula

End With

Set wb = Nothing
Application.ScreenUpdating = True ' turn on the screen updating
y = y + 1
ActiveSheet.Cells.Select
ActiveSheet.UsedRange.Columns.AutoFit

Set wb = Nothing ' free memory
Else
End If
Next x






End Sub



Every time when i run this code , if the statement is true , will pop out
one MSG box to reopen the file......any problem in looping?