View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Clear 4 cells in every file in folder

Two errors in this:

For Each WS In Wkb.Worksheets
Range("C1:C4").Clear
Next WS

It should be

For Each WS In Wkb.Worksheets
WS.Range("C1:C4").ClearContents
Next WS

You need to specify the worksheet, and you don't want to clear, since that removes formatting as
well.

HTH,
Bernie
MS Excel MVP


wrote in message
...
On Aug 21, 10:00 am, Diddy wrote:
Hi everyone,

I wonder if anyone could help me with this please?

I would like to clear the contents of cells C1-C4 in all the sheets in all
the files in one folder.

I'm only just getting to grips with looping through and just can't work this
out.

Many thanks
--
Deirdre


Hi Deird

The following should do the trick for you. Paste this into a new
module in the VBA editor.

Function GetDirectory(Optional msg) As String
On Error Resume Next
Dim bInfo As BrowseInfo
Dim path As String
Dim R As Long, x As Long, pos As Integer

'Root folder = Desktop
bInfo.pIDLRoot = 0&

'Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Please select the folder of the excel files
to copy."
Else
bInfo.lpszTitle = msg
End If

'Type of directory to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
path = Space$(512)
R = SHGetPathFromIDList(ByVal x, ByVal path)
If R Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub ClearCs()
Dim path As String
Dim Filename As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
path = GetDirectory
Filename = Dir(path & "\*.xls", vbNormal)
Do Until Filename = ""
' If Filename < ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
For Each WS In Wkb.Worksheets
Range("C1:C4").Clear
Next WS
Wkb.Close True
' End If
Filename = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Wkb = Nothing
End Sub