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
Most of the code appears to do clean up. where do you pull data to your database from ?
Ravi

 

[Poco90]

Hi Ravi,
Yes its mainly clean up. All of these XLS files have had data manually entered in over the last year by some users. This has being replaced by a database. I'm trying to tidy up each of the workbooks one at a time so I can copy the data directly into the database tables.
Poco

 

[ravishankar]

HI
It is possible to pull data from closed files from specific cells. See http://www.mrexcel.com/forum/showthread.php?t=412589
Try the following codes on a set of sample files (since it saves the modifications made). It lists all files in the folder in col A and opens each of them and runs the cleanup macro on each sheet. It alerts on the workbookname and sheet name it is going to cleanup before hand (I know this slows down the macrnce you are convinced it is working satisfactorily, this line of code can be removed.)

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("Sheet1").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(a).Name
Worksheets(a).Select
Call CleanCost1_1
ActiveWorkbook.Close True
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "cleanup is complete."
End Sub

ravi

 

[Poco90]

Hi Ravi,
Thanks for your response, when I try your code I get the following error

Compile Error:
End if without block If

Thanks to the link for the other post. I will see if I can modify it to suit me.
Rgds,
Poco

 

[snowblizz]

You could change this

' 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

to this

' Delete Job Card Sheet & Master Sheet
    Application.DisplayAlerts = False
    Sheets("Job Card").Delete
Sheets("Master").Delete
    Application.DisplayAlerts = True

and the reason the code fails is it is missing a "next y" statement, but I'm not entirely sure where in the loop it should be placed. A good guess though:

Call CleanCost1_1
next y ' here probably
ActiveWorkbook.Close True
End If
</pre>

 

[ravishankar]

HI
try inserting the line Next y as shown below

Call CleanCost1_1
[B]Next y[/B]
ActiveWorkbook.Close True

Ravi

 

[Poco90]

Thanks Ravi and Snowblizz for the replies.

I inserted the Next Y and it fixed the compile error.

I ran the Macro and it kind of runs.
Rows 1 to 24 are deleted, I was looking for rows 1 to 26 to be deleted.
The macro rearranges my data. In my original code if a cell in column b was empty then the entire row would be deleted. In the new code it looks like only the cell is deleted so the data becomes misaligned, see below.

Other formatting from my orignal code doesn't happen. I'm not sure if this is bacause of the error or not.

Original Data
Qty Time Tasks Completed
(mins) A B C D
7350 405 34
105 38

7250 450 34
60 38

2620 245 34
4700 190 33
75 38

3000 75 33
5540 395 34 38
100 40 1

Edited Data after Macro
Qty Time A B C D Comment
7350 (mins) 34 38
7250 405 38
2620 105 34
4700 450 38
3000 60 34
5540 245 33
100 190 38
75 33
75 34
395 1
40
Please note Qty = Column B in the the workbook



The error I get when running the new macro is.

Runtime Error 9:
Subscript out of range

when I hit debug it highlights
MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets(a).Name

Thanks again for all the help,
Poco

 

[Poco90]

Thanks Ravi and Snowblizz for the replies.

I inserted the Next Y and it fixed the compile error.

I ran the Macro and it kind of runs.
Rows 1 to 24 are deleted, I was looking for rows 1 to 26 to be deleted.
The macro rearranges my data. In my original code if a cell in column b was empty then the entire row would be deleted. In the new code it looks like only the cell is deleted so the data becomes misaligned, see below.

Other formatting from my orignal code doesn't happen. I'm not sure if this is bacause of the error or not.

Original Data
Qty Time Tasks Completed
(mins) A B C D
7350 405 34
105 38

7250 450 34
60 38

2620 245 34
4700 190 33
75 38

3000 75 33
5540 395 34 38
100 40 1

Edited Data after Macro
Qty Time A B C D Comment
7350 (mins) 34 38
7250 405 38
2620 105 34
4700 450 38
3000 60 34
5540 245 33
100 190 38
75 33
75 34
395 1
40
Please note Qty = Column B in the the workbook



The error I get when running the new macro is.

Runtime Error 9:
Subscript out of range

when I hit debug it highlights
MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets(a).Name

Thanks again for all the help,
Poco

 

[snowblizz]

Thanks Ravi and Snowblizz for the replies.

The error I get when running the new macro is.

Runtime Error 9:
Subscript out of range

when I hit debug it highlights
MsgBox ActiveWorkbook.Name & Chr(10) & Worksheets(a).Name

Thanks again for all the help,
Poco

There are 2 things immediately comes to mind, first as the clean up code is called on each sheet it will fail most likely trying to delete non-existing sheets. So move the "Master" and "Job card" deletes to the other sub.
Can you check what the value of

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

is? when you run it and it fails and you debug and check the yellow highlight. Hover over it and see if it says anything beside "subscript out of range". I'm curious what the value of Worksheet is when it fails.
If you have changed anything in the code please post up all the code again.