maksinx
03-04-2007, 11:05 AM
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
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