to modify an existing code

[maksinx]

Good evening everyone,

the below codes deletes the entire excel sheet called report by double clicking;
and also deletes any blank rows between datas;

since i would like to add some sorting code by colors and i need to add the color index into a column in the same file + below formula = colorindexofcell(a1,false,true) i need to exclude 2 columns for deleting the report.To reason for that everyday we run the report and next time there are new entries and report needs to be run again

when i double click anywhere on report sheet it deletes the colorindex and formula column as well is there anyway to modify below code by excluding two rows such as "ag" and "ah" column,for deleting process

please advice

thanks in advance






Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call Delete_Report
Range(Range("a1"), Cells(Cells.Rows.Count, 1).End(xlUp)) _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

[geekgirlau]

Hi maksinx,

Would you please post the code for the Delete_Report procedure as well?

[maksinx]

please find the codes as requested,
i would send a demo file if you like.

thanks for your help in advance




' RENK ?NDEKS?N? DE?ERLER? G?RMEK ???N A?A?IDAK? ColorIndex ?S?ML? MAKROYU YAZDIM VE ?ALI?TIRDIM. Colors ?S?ML? B?R SAYFA EKLED? VE RENK ?NDEKS?N? D?KT?. O SAYFA ???NE BA?KA ?ALI?MALARINDA DA ???NE YARAYAB?L?R.
Sub ColorIndex()
Dim b As Byte
On Error GoTo EndCode
Sheets.Add.Name = "Colors"
Sheets("Colors").Activate
For b = 1 To 56
Cells(b, 1).Interior.ColorIndex = b
Cells(b, 2) = "Indeks de?eri = " & b
Next
Columns(2).AutoFit
EndCode:
End Sub
Sub Calculate_Eta_Report_For_Next_Five_Days()
'
' Name - Define MyRange'deki de?erleri de?i?tirmene gerek yoktu asl?nda ama e?er de?i?tireceksen a?a??daki gibi olsun:
' =OFFSET(Sheet1!$A$2;0;0;COUNTA(Sheet1!$A$2:$A$65536);COUNTA(Sheet1!$A$1:$IV $1))
'
Dim lastrow As Long
Dim CeL As Range
Dim CeLF As Range
Dim L As Long
Dim InvoiceCounter As Long
Dim ETACounter As Long
Dim Prcss As String
Dim Inv As String
Set S1 = Sheets("JUN 2007")
Set S2 = Sheets("report")
On Error Resume Next
S2.Columns("A:AE").Delete ' Bu b?l?mdeki A:F yazan de?erleri yeni s?tun de?erleri ile de?i?tirmelisin. ?rne?in 25 S?tun i?in: S2.Columns("A:Y").Delete gibi
S1.Range("A1:AE1").Resize(, 32).Copy S2.Range("A1") ' S1.Range("A1:Y1").Resize(, 25).Copy S2.Range("A1")
lastrow = WorksheetFunction.CountA(S1.Range("A:A")) ' A s?tunundaki dolu h?crelerin adedini verir.
S1.Activate
L = 2
InvoiceCounter = 0
ETACounter = 0
For Each CeL In Range("A2:A" & lastrow) ' T?m i?lemleri A2 ile A s?tununda LastRow'un de?eri kadar ki h?creler i?inde i?lem yap?l?yor.
If CeL.Offset(0, 4) <= Date + 5 Then ' Buradaki CeL.Offset(0, 4) ile yap?lan ?ey ?u: CeL isimli de?i?kenin d?ng? i?indeki ge?erli h?creden sola do?ru 4 h?cre kadar 'KAYDIR'arark ( Offset ) yaparak h?creye bak demek. Bizim ?rne?imizde E s?tunundaki d?ng? i?indeki ge?erli tarih de?erini kontrol ediyor.
If CeL.Interior.ColorIndex = xlNone _
Or CeL.Interior.ColorIndex = 2 Then
CeL.Resize(, 32).Copy S2.Cells(L, 1) ' CeL.Resize(, 25).Copy S2.Cells(L, 1)
ETACounter = ETACounter + 1
L = L + 1
End If
End If
Next CeL
'
For Each CeLF In Range("A2:A" & lastrow)
If CeLF.Offset(0, 16) = "" And CeLF.Offset(0, 16).Interior.ColorIndex = 34 Then ' Burada 34 yerine sar? bir renk istiyorsan: 6 - 27 - 36 veya 44 de?erlerinden birini se?ip kodu d?zenlemen gerekli olacak. Renk de?erlerinin renk kar??l?klar? i?in ?stte verdi?im kodu ?al??t?rabilirsin.
CeLF.Resize(, 32).Copy S2.Cells(L, 1) 'CeLF.Resize(, 25).Copy S2.Cells(L, 1)
InvoiceCounter = InvoiceCounter + 1
L = L + 1
End If
Next CeLF
S2.Columns("A:AE").ColumnWidth = 15 ' S2.Columns("A:Y").ColumnWidth = 15
S2.Rows("1:115").RowHeight = 15
S2.[A1].Select
'
Select Case ETACounter
Case Is < 2
Prcss = "Process"
Case Else
Prcss = "Processes"
End Select
'
Select Case InvoiceCounter
Case Is < 2
Inv = "Invoice"
Case Else
Inv = "Invoices"
End Select
'
MsgBox "You Have " & ETACounter & " ETA " & Prcss & " and also you should make out " & InvoiceCounter & " " & Inv & "."
Set S1 = Nothing
Set S2 = Nothing
End Sub
'SHEET2'DE ??FT TIKLAMA YAPTI?IN ZAMAN ALDI?IN RAPOR S?L?NECEK
'SHHET1'DE 'Delete Report On Sheet2' ?S?ML? BUTONA BASTI?INDA DA ALDI?IN RAPOR S?L?NECEK.
Sub Delete_Report()
Set S2 = Sheets("report")
S2.Range("A2:IV65536").Delete
End Sub

[JimmyTheHand]

Hi :hi:

Try this code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wks As Worksheet
Call Delete_Report
Set wks = ThisWorkbook.Worksheets.Add

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Range("AG:AH").Copy wks.Range("A:B")
Range("a1", Cells(Cells.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
wks.Range("A:B").Copy Range("AG:AH")

wks.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
It's not really elegant, but it works.
If you have a helper sheet, maybe a hidden helper sheet, then you can use it to copy the range ("AG:AH") there, and so many lines would be unnecessary, resulting in a much shorter code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wks As Worksheet
Call Delete_Report
Set wks = Sheets("Helper") 'change as necessary

Range("AG:AH").Copy wks.Range("A:B")
Range("a1", Cells(Cells.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
wks.Range("A:B").Copy Range("AG:AH")

End Sub
HTH

Jimmy

[maksinx]

jimmy,
can you tell me how canmodify my existing code?
please advice

thanks in advance

[JimmyTheHand]

jimmy,
can you tell me how canmodify my existing code?
please advice

thanks in advance
maksinx,

post #4 was the modification of your existing code...
I'll tell you what it does.
1.) calls Delete_Report (as in your original code)
2.) adds a new sheet to the workbook
3.) copies columns AG and AH to the new sheet
4.) deletes rows with empty cell in column A (as in your original code)
5.) restores columns AG and AH from their backups on the new sheet
6.) deletes the new sheet.

Steps 2, 3, 5 and 6 are the extra ones. Their purpose is to create a backup of columns AG and AH, and restore from it.
If it's not what you wanted in the first place, please show me an example.

Jimmy