dakkat
05-25-2010, 01:05 PM
Hello,
I have been working on this code for a while now and am having some issues that I would like to see if I can get a solution for. I have a workbook with over 100 worksheets. Each worksheet that I want to run this code on are using the same template.
The code below is running but not as I would like. Here is the scenario:
Sub Offline()
Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
Dim i As String
i = "Project Time"
With Worksheets("Sheet13 (64)")
Set r = .Range(.Range("E52"), .Range("E52").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If cell.Value = i Then
fDate = cell.Offset(0, -2).Value
cell.Offset(0, 3).Copy
Set c = sh.Range("A17:A47").Find(fDate, LookIn:=xlValues)
If Not c Is Nothing Then
sh.Range("C" & c.Row).PasteSpecial xlPasteValues
sh.Range("E" & c.Row).PasteSpecial xlPasteValues
sh.Range("F" & c.Row).PasteSpecial xlPasteValues
sh.Range("G" & c.Row).PasteSpecial xlPasteValues
sh.Range("H" & c.Row).PasteSpecial xlPasteValues
sh.Range("I" & c.Row).PasteSpecial xlPasteValues
sh.Range("J" & c.Row).PasteSpecial xlPasteValues
sh.Range("K" & c.Row).PasteSpecial xlPasteValues
sh.Range("L" & c.Row).PasteSpecial xlPasteValues
sh.Range("M" & c.Row).PasteSpecial xlPasteValues
sh.Range("N" & c.Row).PasteSpecial xlPasteValues
sh.Range("O" & c.Row).PasteSpecial xlPasteValues
sh.Range("P" & c.Row).PasteSpecial xlPasteValues
sh.Range("Q" & c.Row).PasteSpecial xlPasteValues
sh.Range("R" & c.Row).PasteSpecial xlPasteValues
sh.Range("T" & c.Row).PasteSpecial xlPasteValues
sh.Range("U" & c.Row).PasteSpecial xlPasteValues
sh.Range("V" & c.Row).PasteSpecial xlPasteValues
sh.Range("W" & c.Row).PasteSpecial xlPasteValues
sh.Range("X" & c.Row).PasteSpecial xlPasteValues
sh.Range("Y" & c.Row).PasteSpecial xlPasteValues
sh.Range("Z" & c.Row).PasteSpecial xlPasteValues
sh.Range("AA" & c.Row).PasteSpecial xlPasteValues
sh.Range("AB" & c.Row).PasteSpecial xlPasteValues
sh.Range("AC" & c.Row).PasteSpecial xlPasteValues
sh.Range("AQ" & c.Row).PasteSpecial xlPasteValues
End If
End If
Next
Next
End Sub
Issues:
1) I would like to just delete the values in the cells but instead, I am copying a blank cell and pasting it into the cells I want cleared.
2) This test is running on all worksheets and I need a way to have it run for each worksheet separately. (Currently using values on "Sheet13 (64)" to delete on all worksheets. Would like to specify something like below to identify which worksheets to run this script on (each worksheet that has an email address in the C3 field):
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("C3").Value Like "?*@?*.?*" Then
So basically, I am setting a range from E52 down until no values and if any cell in that range is equals 'Project Time' it is looking that the date 2 cells to the left and then taking that date and finding a match in the range of "A17:A47" and when found it is to clear the multiple cell values in that row.
There has to be an easier way to clear values than copying a blank cell and pasting it like my code is doing.
Please, any assistance would be greatly appreciated.
Thank you,
I have been working on this code for a while now and am having some issues that I would like to see if I can get a solution for. I have a workbook with over 100 worksheets. Each worksheet that I want to run this code on are using the same template.
The code below is running but not as I would like. Here is the scenario:
Sub Offline()
Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
Dim i As String
i = "Project Time"
With Worksheets("Sheet13 (64)")
Set r = .Range(.Range("E52"), .Range("E52").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If cell.Value = i Then
fDate = cell.Offset(0, -2).Value
cell.Offset(0, 3).Copy
Set c = sh.Range("A17:A47").Find(fDate, LookIn:=xlValues)
If Not c Is Nothing Then
sh.Range("C" & c.Row).PasteSpecial xlPasteValues
sh.Range("E" & c.Row).PasteSpecial xlPasteValues
sh.Range("F" & c.Row).PasteSpecial xlPasteValues
sh.Range("G" & c.Row).PasteSpecial xlPasteValues
sh.Range("H" & c.Row).PasteSpecial xlPasteValues
sh.Range("I" & c.Row).PasteSpecial xlPasteValues
sh.Range("J" & c.Row).PasteSpecial xlPasteValues
sh.Range("K" & c.Row).PasteSpecial xlPasteValues
sh.Range("L" & c.Row).PasteSpecial xlPasteValues
sh.Range("M" & c.Row).PasteSpecial xlPasteValues
sh.Range("N" & c.Row).PasteSpecial xlPasteValues
sh.Range("O" & c.Row).PasteSpecial xlPasteValues
sh.Range("P" & c.Row).PasteSpecial xlPasteValues
sh.Range("Q" & c.Row).PasteSpecial xlPasteValues
sh.Range("R" & c.Row).PasteSpecial xlPasteValues
sh.Range("T" & c.Row).PasteSpecial xlPasteValues
sh.Range("U" & c.Row).PasteSpecial xlPasteValues
sh.Range("V" & c.Row).PasteSpecial xlPasteValues
sh.Range("W" & c.Row).PasteSpecial xlPasteValues
sh.Range("X" & c.Row).PasteSpecial xlPasteValues
sh.Range("Y" & c.Row).PasteSpecial xlPasteValues
sh.Range("Z" & c.Row).PasteSpecial xlPasteValues
sh.Range("AA" & c.Row).PasteSpecial xlPasteValues
sh.Range("AB" & c.Row).PasteSpecial xlPasteValues
sh.Range("AC" & c.Row).PasteSpecial xlPasteValues
sh.Range("AQ" & c.Row).PasteSpecial xlPasteValues
End If
End If
Next
Next
End Sub
Issues:
1) I would like to just delete the values in the cells but instead, I am copying a blank cell and pasting it into the cells I want cleared.
2) This test is running on all worksheets and I need a way to have it run for each worksheet separately. (Currently using values on "Sheet13 (64)" to delete on all worksheets. Would like to specify something like below to identify which worksheets to run this script on (each worksheet that has an email address in the C3 field):
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("C3").Value Like "?*@?*.?*" Then
So basically, I am setting a range from E52 down until no values and if any cell in that range is equals 'Project Time' it is looking that the date 2 cells to the left and then taking that date and finding a match in the range of "A17:A47" and when found it is to clear the multiple cell values in that row.
There has to be an easier way to clear values than copying a blank cell and pasting it like my code is doing.
Please, any assistance would be greatly appreciated.
Thank you,