Looping(Rookies)

K

KK

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?
 
S

Sam Wilson

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 said:
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?
Click to expand...
 
K

KK

Hi SAM ,

I had try your method to move Set wb = Workbooks.Open(tbFile, True, True)
to out of for loop , but the loop run once then occur error From
T282=IF(R282="Yes","YES","No") to
T930=IF(R930="Yes","YES","No")

anything i should edit after migrate the set wb?

Sam Wilson said:
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 said:
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?
Click to expand...
Click to expand...
 
S

Sam Wilson

Yes, remove the "Set wb = Nothing" lines (or at least comment them out)

KK said:
Hi SAM ,

I had try your method to move Set wb = Workbooks.Open(tbFile, True, True)
to out of for loop , but the loop run once then occur error From
T282=IF(R282="Yes","YES","No") to
T930=IF(R930="Yes","YES","No")

anything i should edit after migrate the set wb?

Sam Wilson said:
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 said:
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?
Click to expand...
Click to expand...
Click to expand...
 
K

KK

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 x1 As Integer
Dim y13 As Integer

Dim value As String
Dim count As String
Set wb = Workbooks.Open(tbFile, True, True)

y1 = 6
For x1 = 2 To 930
Worksheets("Task_Table1").Select

Application.Goto Reference:="R" & x1 & "C20"

ActiveCell.FormulaR1C1 =
"=IF((LEFT(RC[-17],LEN(RC[-17])-4)+1)>11,(IF(RC[-13]<>""Yes"",(IF(RC[-10]<>1,""YES"",""No"")),""No"")),""No"")"
value = ActiveCell.value





If (value <> "No") Then

Workbooks("Project_Analyzer_v2").Activate

' 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("A5").Formula = "ID"
.Range("B5").Formula = "Task"
.Range("C5").Formula = "Duration"
.Range("D5").Formula = "Start Date"
.Range("E5").Formula = "Finish Date"
' read data from the source workbook
.Range("A" & y1).Formula = wb.Worksheets("Task_Table1").Range("A" &
x1).Formula
.Range("B" & y1).Formula = wb.Worksheets("Task_Table1").Range("B" &
x1).Formula
.Range("C" & y1).Formula = wb.Worksheets("Task_Table1").Range("C" &
x1).Formula
.Range("D" & y1).Formula = wb.Worksheets("Task_Table1").Range("D" &
x1).Formula
.Range("E" & y1).Formula = wb.Worksheets("Task_Table1").Range("E" &
x1).Formula

End With
y1 = y1 + 1

Else


End If
Next x1

End Sub


This is my latest coding,I had migrate out the set wb out ,but it run once
then pop out run time error "9" subscript out of range, if a add the
windows("tbFile").activate before the worksheet("Task_Table1") , same the
error , add windows(tbFile).activate then the error "type mismatch", i also
try to change windows(tbFile) to workbooks(tbFile) ,the error "type mismatch"
is display,anyone can help me ?
 

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

Similar Threads

workbook open in looping 2
If statement(rookies) 3
Permutations andText to column problem 6
Error '1004' 4
Can you speed up this code? 2
passing a parameter from a button invoked VBA macro? 2
Analyst tool Pack 1
sheets(N*).printout problem 10

Top