Solved: Looping through W/sheets and delete blank rows?

[Simon Lloyd]

Hi all, can anyone supply a method to loop through all worksheets and delete entire rows that are completely blank?. I have a workbook that has a varying amount of worksheets (up to 26) my first sheet is called "Front" and i want to leave that one alone, all the other sheets generated will have varying sheet names, finally i want to copy all sheets to a new workbook called "Summary" except the sheet marked "Front". Can anyone help?

Regards,
Simon

P.S Is it also possible to delete all sheets except "front" once the "Summary" workbook has been created?

[Bob Phillips]

Only tested to compile okay I am afraid, just rattled it off

[vba]

Sub Simon()
Dim rng As Range
Dim sh As Worksheet
Dim oRow As Range
Dim cSheets As Long
Dim oWB As Workbook

cSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oWB = Workbooks.Add
Application.SheetsInNewWorkbook = cSheets

For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Front" Then
Set rng = Nothing
For Each oRow In sh.UsedRange.Rows
If Application.CountA(oRow.EntireRow) = 0 Then
If rng Is Nothing Then
Set rng = oRow.EntireRow
Else
Set rng = Union(rng, oRow.EntireRow)
End If
End If
Next oRow
If Not rng Is Nothing Then rng.Delete
sh.Move after:=oWB.Worksheets(oWB.Worksheets.Count)
End If
Next sh

Application.DisplayAlerts = False
oWB.Worksheets(1).Delete
Application.DisplayAlerts = True

oWB.SaveAs "Summary.xls"

Set rng = Nothing
Set oRow = Nothing
Set sh = Nothing
Set oWB = Nothing

End Sub
[/vba]

[Simon Lloyd]

Thanks "El Xid", will try it in a few of hours when im back home then post back!



Simon

[Simon Lloyd]

"El Xid", thanks for that code, i had trouble with it because it created a new workbook and left just one sheet in it the one from my original workbook called Front!,.....what happens is my original workbook has one sheet i then create multiple sheets with varying names depending on input data.......what i wanted to do is put all these sheets except Front into a new workbook called "Summary". I used the part of the code that removes all the blanks which is brilliant! and i use

ActiveWorkbook.SaveAs "Summary.xls"

which doesnt change my original then i manually delete the sheets created in the original..............the other thing is, when i oWb.SaveAs i get an error because the workbook exists, what i would like to do is if it exists save if not save as, at the moment i have added

"& Format(Date, "dd-mm-yyyy") & ".xls"

so i dont get the error saving the worksheet the next day, i know i could put Now so it saves exact time but its not ideal i just want the file as the one name.

Any ideas?

Regards,
Simon

[Bob Phillips]

Simon,

Can I just clarify?

You want to:
- for each sheet that is not 'Front', clear blanks and copy to Summary
- leave all in current workbook

What I don't fully understand is whether you add sheets to the current workbook and how we stop the previous sheets being copied again and again?

[Simon Lloyd]

This is how i create my new worksheets in my original workbook
[VBA]
Sub ShtCreate()
Dim mycell
Dim rng As Range
Set rng = Sheets("Front").Range("A2:A50")
For Each mycell In rng
If mycell.Value = "" Then
ElseIf mycell.Value <> "" Then
Sheets.Add
ActiveSheet.Name = mycell.Value
End If
Next
End Sub
[/VBA]
Once the sheets are created i would like them to be moved to a new workbook called "summary"
[VBA]
Sub SummarySave()
Dim rng As Range
Dim sh As Worksheet
Dim oRow As Range
Dim cSheets As Long
For Each sh In ActiveWorkbook.Worksheets
Application.DisplayAlerts = False
If sh.Name <> "Front" Then
Set rng = Nothing
For Each oRow In sh.UsedRange.Rows
If Application.CountA(oRow.EntireRow) = 0 Then
If rng Is Nothing Then
Set rng = oRow.EntireRow
Else
Set rng = Union(rng, oRow.EntireRow)
End If
End If
Next oRow
If Not rng Is Nothing Then
rng.Delete
End If
Next sh

ActiveWorkbook.SaveAs "Report Summary"

& Format(Date, "dd-mm-yyyy") & ".xls"

Application.DisplayAlerts = True
Set rng = Nothing
Set oRow = Nothing
Set sh = Nothing
End Sub
[/VBA]
the data that i or a user would enter on the Front sheet could be changed a few times a day, however it is always the last change we are interested in.......so if i created the sheets once then save as Summary and then later that day change the data on the Front sheet, run my code and save as Summary i want the first copy of Sumary overwritten (the next day it would not matter if todays was overwritten!). Everytime i close the original workbook i want to delete all sheets except Front.

This probably still isnt clear to you, but if you want to climb inside this very cluttered head of mine you could see a clear picture! haha!.

Regards,
Simon

[Simon Lloyd]

This is what i have so far this creates the sheets
[VBA]
Sub ShtCreate()

Dim mycell
Dim rng As Range
Set rng = Sheets("Front").Range("A2:A50")
For Each mycell In rng
If mycell.Value = "" Then
ElseIf mycell.Value <> "" Then
Sheets.Add
ActiveSheet.Name = mycell.Value
End If
Next

End Sub

[/VBA]

This removes all blank cells and saves as Report Summary

[VBA]

Sub SummarySave()

Dim rng As Range

Dim sh As Worksheet

Dim oRow As Range
Dim cSheets As Long

For Each sh In ActiveWorkbook.Worksheets
Application.DisplayAlerts = False
If sh.Name <> "Front" Then
Set rng = Nothing
End If
For Each oRow In sh.UsedRange.Rows
If Application.CountA(oRow.EntireRow) = 0 Then
If rng Is Nothing Then
Set rng = oRow.EntireRow
Else
Set rng = Union(rng, oRow.EntireRow)
End If
End If
Next oRow
If Not rng Is Nothing Then
rng.Delete
End If
Next sh

ActiveWorkbook.SaveAs "Report Summary"& Format(Date, "dd-mm-yyyy") & ".xls"
Set rng = Nothing
Set oRow = Nothing
Set sh = Nothing
Call ShDel
End Sub

[/VBA]

and this code is supposed to delete all worksheets from the original but leave the front sheet there, but it doesnt work!

[VBA]

Sub ShDel()

Dim shM As Worksheet

ThisWorkbook = Mwb

For Each shM In Mwb

If shM.Name <> "Front" Then
sh.Delete
End If
Next
Set shM = Nothing
Application.DisplayAlerts = True
End Sub

[/VBA]

Any ideas?......one other thing when saving the workbook as Report Summary i would like to remove the sheet called front!

Regards,
Simon

[mdmackillop]

Hi Simon,
When you post code, select it and click the VBA button, rather than use the Code tags

[mdmackillop]

[VBA]Sub ShDel()
Dim shM As Worksheet
Dim Mwb As Workbook

Set Mwb = ThisWorkbook
Application.DisplayAlerts = False
For Each shM In Mwb.Worksheets
If shM.Name <> "Front" Then
shM.Delete
End If
Next
Set shM = Nothing
Set Mwb = Nothing
Application.DisplayAlerts = True
End Sub
[/VBA]

[Simon Lloyd]

My apologies MD, i have used the www.mcse.ms site and thats how they did it there, i will of course adhere to this forums preferred method.

Thanks for the revised code...........i made a couple of schoolboy errors, but thats what learning and help forums are all about.

Thanks again,

Regards,
Simon

P.S can you point me in the right direction for error handling an existing or open workbook of the name i am saving the workbook as?, right now i have added the current date to the filename but its not ideal.

[mdmackillop]

Hi Simon,
No apologies necessary, but I think the VBA tagged code is easier to comprehend.

Regarding your workbook, are you looking to add an incrementing number to a filename if it already exists?

[Simon Lloyd]

Yes!, a file number would be of great help as there are lots of workbooks stored on the network quite a few are called summary or summary report (can't get people to agree what they will call their workbooks!), is it possible that when a named & numbered file is created that the name and number could be stored in a workbook perhaps called index, if it is i could turn all the entries into hyperlinks to the workbooks, this way i would have a shot at getting everyone to access the one index for their file.....it would clear up the network drive no end!

Regards,
Simon

[Simon Lloyd]

Just a portion of code to spark some interest on collecting workbook names and putting them in one workbook on one page then turn them into hyperlinks! [VBA]Sub wbookfind()
Dim rng As Range
Dim Wb As Workbook
Set rng = Range("E:\")
For Each Wb In rng
If Wb.Name <> "Book1" Then
Wb.Name.Copy ' This doesnt work here for collecting worbook names!
Sheets("Sheet1").Range("A1").Select
Selection.End(xlDown)(2).Select
ActiveSheet.Paste
End If
Next
End Sub[/VBA]Of course this doesnt work as i should probably use GetName() but i am unsure of how or when to use it and as for hyperlinks i thought i might try [VBA].Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= "'Workbookname'!A1",TextToDisplay:="workbookname"[/VBA] and again im not sure on the use of this!.

As for the incremental filename for the workbook above do i just have a number lets say at the bottom of the Front sheet e.g 10000 and on SaveAs add 1 to it so every time the workbook is saved i could include this cell as the filename?

regards,
Simon

[Simon Lloyd]

This is what i have so far in collecting workbook names in a set directory and saving them on a worksheet, then saving the workbook, however can anyone help with some code turning the names into hyperlinks so that you can open the required workbook directly from the hyperlink?
[vba]
Sub FindBooks()
Dim F As String, i As Integer, n As Integer, wks As Worksheet
i = 1
Set wks = ActiveWorkbook.Worksheets.Add wks.Cells(i, 1).Value = F
F = Dir("C:\Documents and Settings\gbksxl04\my documents\*.xls", vbNormal)
Do While F <> "" 'loop through all the files
wks.Cells(i, 1).Value = F
i = i + 1
F = Dir
Loop
n = i - 1
MsgBox "there were " & n & " Files Found"
wks.Range(Cells(1, 1), Cells(n, 1)).Sort _
Key1:=wks.Cells(1, 1), Order1:=xlAscending, _
OrderCustom:=1, Orientation:=xlSortRows, _
Header:=xlNo, MatchCase:=False
Application.DisplayAlerts = False
F = "C:\Documents and Settings\gbksxl04\my documents\Global Index.xls"
ActiveWorkbook.SaveAs Filename:=F
Application.DisplayAlerts = True
End Sub
[/vba]

Regards,
Simon

[Simon Lloyd]

I have added the purple code below for making hyperlinks, it does indeed make the text into a hyperlink but you can not use it later to go to the file any ideas why?[vba]Do While F <> ""
wks.Cells(i, 1).Value = F
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=F, TextToDisplay:=F
ActiveCell.Offset(1, 0).Select
i = i + 1
F = Dir
Loop [/vba] Is it something to do with the address?, also when i sort the list will the links still open the books they were supposed to?

Hope you can help its driving me mad been at it for days 'n' days.

Regards,
Simon

[Simon Lloyd]

Sorted the problem i was missing telling it which drive the files belonged to like below [vba]ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="E:\" & F, TextToDisplay:=F[/vba]And the sorting of them works!

What a load off....................!

Regards,
Simon