Loop Macro. Prompt input.

[Poco90]

Hi,
I have several hundred workbooks with multiple worksheets(15-35) that I am trying to tidy up, so the data can be entered into a database. Its my first attempt at VBA and between the forum and macro recorder I made an attempt which is below. I just can't seem to get over the last part. I have searched the forum but can't seem to find any relevant information. I have a couple of questions.


1. I need to be able to run this macro over all the worksheets in the workbook, so how can I loop it? All the worksheets are named differently i.e. peoples names.

2. In my code I have inserted 4 columns. These columns will be the only thing common between all the worksheets. A1 to A30 = Week number, B1 to B30 = Shift Number, C1 to C30 = Supervisor number. Column D is blank. I'd like to be able to be prompted to enter these 3 numbers at the start if possible? Can this be done in such a way as you are only prompted the once and not on each worksheet? I picked 30 rows because the amount of rows in each worksheet varies but never exceeds this. The end of my code "Delete rows where cell B is blank" will delete any excess data where 30 rows of week numbers etc are not needed.

Thanks in advance,
Poco


Sub CleanCost1_1()
'
' CleanCost1_1 Macro
' Macro recorded 04/09/2009
'

' Delete Job Card Sheet
Sheets("Job Card").Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
' Delete Master Sheet
Sheets("Master").Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
' Delete Rows 1 to 26
Rows("1:26").Select
Selection.Delete Shift:=xlUp
'Select All cells Zoom 100 and remove grid
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.Zoom = 100
'Move row E to A
Columns("E:E").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
'Insert 4 Columns
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("F27").Select
'Delete rows where cell B is blank
Dim LR As Long
LR = Cells.Find("*", searchdirection:=xlPrevious, SearchOrder:=xlByRows).Row
On Error Resume Next
Range("B1:B" & LR - 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

 

[ravishankar]

Hi
You can fix the Runtime Error 9 using

MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets(y).Name

Check your cleancost macro and ensure it is working as you want it to.
Ravi

 

[Poco90]

Hi Ravi and Snowblizz

Snowblizz
When I hover over the text, ActiveWorkbook.Name="new.xls" is displayed. I don't know what you mean by moving the "Master" and "Job cards" delete to the other sub.

Ravi,
When I make your changes the macro runs all the way through and then I get a Microsoft Exel window displaying new.xls Adam Sad (name of 1st tab). When I ok this I get
Run-time error '9':
Subscript out of range
When I dubug the compiler jumps to a different macro and highlights in yellow some of the code. When I point at this nothing is displayed.

Thanks again,
Poco


Sub cleanup()
Dim z As Long, e As Long, g As Long, y As Long
Dim f As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Job Card").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
If Cells(e, 1) <> ActiveWorkbook.Name Then
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)
For y = 1 To Sheets.Count
MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets.Name
Worksheets.Select
Call CleanCost1_1
Next y
ActiveWorkbook.Close True
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "cleanup is complete."
End Sub

 

[ravishankar]

Hi
try adding a single quote ( ' ) behind 'Call CleanCost1_1 and run the macro.It will disable the cleanup macro but should keep listing the filenames and sheet names indicating the main macro is OK.
ravi

 

[Poco90]

Hi Ravi
thanks again for your time and patience. I ran the macro and it seemed to run ok. I was asked to click ok each of the worksheets names and the macro also went through 3 other xls files I had in that folder.

Now when I run the macro it does not run on the current workbook that I have opened, it only runs on the other workbooks in the folder and asks me to ok each worksheet name. In the end I get a run-time error? I deleted the workbook and macro I tried it all over again from a backed up file and creating a new module. I still have the same result.

The runtime error is 1004
'C:\documents and settings\poco\desktop\Week 7 2009\' could not be found. Check the spelling of the name and verify that the location file is correct.

If you are trying to open the file from your list of most recently used files on the File menu, make sure that the file has not been renamed, moved or deleted.

When I click debug it highlights
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)
Pointing at Cells(1,2) in the code above it shows
Cells(1,2) = "C:\documents and settings\poco\desktop\Week 7 2009\"

The location is correct. I tried a different location on my c drive and get the same error except it points to my new location. Any ideas what the problem is?
Poco

 

[snowblizz]

Is there a filename in the cell

Cells(e, 1)

, should be Cells(2,1), Cells(3,1) that is A2, A3 and so on.

 

[Poco90]

Hi Snowblizz,
No filename, see code below (should have posted it in the first place)
poco

Sub cleanup()
Dim z As Long, e As Long, g As Long, y As Long
Dim f As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Job Card").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
If Cells(e, 1) <> ActiveWorkbook.Name Then
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)
For y = 1 To Sheets.Count
MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets.Name
Worksheets.Select
'Call CleanCost1_1
Next y
ActiveWorkbook.Close True
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "cleanup is complete."
End Sub

 

[snowblizz]

Yeah, that actually does what I think it does... it gets the path of the files and then picks the filenames from there and populates the list.

I tested it myself now and I think I can see at least 1 problem, it seems to be counting the sheets of the original workbook opened.
Look for

For y = 1 To Sheets.Count

and change it to

For y = 1 To ActiveWorkbook.Sheets.Count

That way it at least tried to open the right amount of sheets. This might still not be THE problem though.

 

[Poco90]

Hi snowblizz,
I change the code as you suggested and still get the same problem.
Poco

Sub cleanup()
Dim z As Long, e As Long, g As Long, y As Long
Dim f As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Job Card").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
If Cells(e, 1) <> ActiveWorkbook.Name Then
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)
For y = 1 To ActiveWorkbook.Sheets.Count
MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets.Name
Worksheets.Select
'Call CleanCost1_1
Next y
ActiveWorkbook.Close True
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "cleanup is complete."
End Sub

 

[snowblizz]

I finally got it to run on my computer, I think if you ahve macros, especially those that run on open or activation of the workbook there seems to be problems, I kept having them at least. And it was constantly using the wrong workbook to look in.

Sub cleanup()
'On Error Resume Next
Dim z As Long, e As Long, g As Long, y As Long
Dim f As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Sheets("Job Card").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row

For e = 2 To z
If Cells(e, 1) <> ActiveWorkbook.Name Then
Application.EnableEvents = False
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)

For y = 1 To ActiveWorkbook.Sheets.Count
MsgBox ActiveWorkbook.Name & Chr(10) & ActiveWorkbook.Worksheets(y).Name
ActiveWorkbook.Worksheets(y).Select

'Call CleanCost1_1
Next y
ActiveWorkbook.Close True
Application.EnableEvents = True
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "cleanup is complete."
End Sub

 

[Poco90]

Maybe its my version of Excel (2000) that is the problem. Thanks again for all your help.
Poco