code failure

[maksinx]

Hello everyone,
I have below code which runs by clicking a command button on sheet1;once you click on the button,on sheet2 report is shown but somehow there is something wrong and on the sheet2 there are 51 blank rows between two set of data types.
How can i get rid of these blank rows on sheet2 ?

Any comments highly appreciated.

If you need further information please let me know/

Thanks advance


QUOTE

' 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("Sheet1")
Set S2 = Sheets("Sheet2")
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, 5) = "" And CeLF.Offset(0, 5).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.[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("Sheet2")
S2.Range("A2:IV65536").Delete
End Sub
UNQUOTE

[Simon Lloyd]

Take a look at this link it may help with the deletion of blank rows.
http://vbaexpress.com/forum/showthread.php?t=10234
Regards,
Simon

[maksinx]

hi simon
thanks for the link but could you be more specific as i am not a vb expert
and i dont know which codes i should add to the code i have.

please advice

thanks.

[Simon Lloyd]

An easy way is if usually there should be a value in every cell in column A for the used range then if blanks occur there you could then delete the whole row on that basis, thsi code was supplied by lucas at the thread i posted:


Option Explicit
Sub DeleteBlankColA()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("A2").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "[]"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub
put this code in an ordinary module then in your code use Call DeleteBlankColAwhich will then run the delet code.

Regards,
Simon

[Charlize]

Maybe reset your L variable between the two 'for each' loops. If the second loops want to add data to the first loop. The way it is now L is counting with the first loop and keeps on counting with the second loop. Reset in between to L = 2. Better is to integrate into one loop (or a loop in a loop). If it is possible, attach a sample of your data and the result you want with the code you've already got.

Charlize

[Charlize]

Resizing means to expand your selection. When you sayS1.Range("A1:AE1").Resize(, 32).Copy S2.Range("A1")you don't need to resize because you used the range a1:ae1. Instead use Dim s1 As Worksheet
Set s1 = Worksheets(1)
s1.Range("A1").Resize(, 31).Copywill copy the range a:ae
Charlize

[Charlize]

Instead ofS2.Columns("A:AE").Delete you could use S2.Cells.ClearContents which will clear all the cells in sheet 2

Charlize