Assistance needed with Macro Modification

A

akemeny

Some of the workbooks that I use have anywhere between 5-15 spreadsheets, but
when its open only a few of those will actually be used or have any changes
made in them. So... Is there a way to adjust the macro below so that it will
only run in the spreadsheets that had changes made while the workbook was
open?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim c As Range
For Each wS In Worksheets
For Each c In wS.UsedRange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
Next wS
ThisWorkbook.Save
End Sub
 
N

Nigel

AFAIK changes to any sheet is only known at workbook level.

I have not tried this but use the worksheet change event to set a boolean or
a cell on the sheet to indicate change

On each worksheet code add this...., (I used cell A1 but it needs to be
somewhere out of user eyesight or all sheet changes stored on another
sheet!)

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Cells(1, 1) = True
End Sub

Then use your code modified as follows....

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim c As Range
For Each wS In Worksheets
If wS.Cells(1, 1) Then
wS.Cells(1, 1) = False
For Each c In wS.UsedRange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
End If
Next wS
ThisWorkbook.save
End Sub
 
M

Mike H

Hi,

You could set a marker cell to indicate whether a sheet had changed and only
run your code on that sheet if the marker cell is populated. You would need
to clear the marker cell when the workbook is opened. When choosing a marker
cell bear in mind that if you chose (say) Iv65536 then that increases the
used range and the whole thing could be counter productive in saving time
which is what I presume you are attempting to do.

Private Sub Workbook_Open()
For x = 1 To Worksheets.Count
Application.EnableEvents = False
Sheets(x).Range("D1").ClearContents
Application.EnableEvents = True
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Range("D1").Value = "changed"
Application.EnableEvents = True
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim c As Range
For Each wS In Worksheets
If wS.Range("D1").Value = "changed" Then
For Each c In wS.UsedRange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
End If
Next wS
ThisWorkbook.Save
End Sub


Mike
 
A

akemeny

Ok... so I use (for instance) cell c1 to set the boolean then have the code
set for cells(1, 3)... correct?

I've never set a boolean in this type of setting, how would I set it to
track if there were any changes made to the spreadsheet?
 
N

Nigel

Sample of codes to use a boolean array to track sheet changes, new
worksheets can be added but the code to monitor these sheets needs to added.

Put this code in a standard module

Public bArray
Sub OpenProc()
Dim iA As Integer
Dim iSheets As Integer
iSheets = ThisWorkbook.Worksheets.Count
ReDim bArray(iSheets)
For iA = 1 To iSheets
bArray(iA) = False
Next
End Sub

In the workbook open event put this

Private Sub Workbook_Open()
OpenProc
End Sub

In each worksheet code put this

Private Sub Worksheet_Change(ByVal Target As Range)
bArray(Me.Index) = True
End Sub

In your workbook code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim c As Range
For Each wS In Worksheets
If bArray(wS.Index) Then
For Each c In wS.UsedRange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
End If
Next wS
ThisWorkbook.Save
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
ReDim Preserve bArray(ActiveWorkbook.Worksheets.Count)
End Sub
--

Regards,
Nigel
(e-mail address removed)
 
A

akemeny

This works great, but it still takes a bit of time when closing for it to go
through every cell. Is there a way that I can narrow down the UsedRange
portion to specific columns in the UsedRange.

For Example: I really only need it to check columns X:BL in the UsedRange
 
M

Mike H

Typo

try this instead

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim MyRange As Range
Dim c As Range
For Each wS In Worksheets
If wS.Range("D1").Value = "changed" Then
lastrow = Cells(Cells.Rows.Count, "X").End(xlUp).Row
lastrow1 = Cells(Cells.Rows.Count, "BL").End(xlUp).Row
Set MyRange = Range("X1:BL" & WorksheetFunction.Max(lastrow, lastrow1))
For Each c In MyRange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
End If
Next wS
ThisWorkbook.Save
End Sub

Mike
 
A

akemeny

One last thing that I just thought might help to lower the amount of time...
I have 4 spreadsheets in each workbook (all named the same in each one) that
I don't need checked. How could I get the macro below to exclude those 4
spreadsheets?

Summary, RAC, FI, QIC

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim MyRange As Range
Dim c As Range
For Each wS In Worksheets
If wS.Range("C1").Value = "changed" Then
lastrow = Cells(Cells.Rows.Count, "X").End(xlUp).Row
lastrow2 = Cells(Cells.Rows.Count, "Z").End(xlUp).Row
lastrow3 = Cells(Cells.Rows.Count, "AA").End(xlUp).Row
lastrow4 = Cells(Cells.Rows.Count, "AH").End(xlUp).Row
lastrow5 = Cells(Cells.Rows.Count, "AI").End(xlUp).Row
lastrow6 = Cells(Cells.Rows.Count, "AO").End(xlUp).Row
lastrow8 = Cells(Cells.Rows.Count, "AQ").End(xlUp).Row
lastrow9 = Cells(Cells.Rows.Count, "AY").End(xlUp).Row
lastrow10 = Cells(Cells.Rows.Count, "AZ").End(xlUp).Row
lastrow11 = Cells(Cells.Rows.Count, "BF").End(xlUp).Row
lastrow12 = Cells(Cells.Rows.Count, "BG").End(xlUp).Row
lastrow13 = Cells(Cells.Rows.Count, "BL").End(xlUp).Row
Set MyRange = Range("X1:BL" & WorksheetFunction.Max(lastrow, lastrow2, _
lastrow3, lastrow4, lastrow5, lastrow6, lastrow8,
lastrow9, _
lastrow10, lastrow11, lastrow12, lastrow13))
For Each c In MyRange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
End If
Next wS
ThisWorkbook.Save
End Sub
 

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

Top