Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default code to color cell



With the following code i wanted him to shadow me the cell that i
doesn't find with blue color but not you where to place the it lines
of code, I believe that it is placed after the function else i would
thank Them a lot them to help me

Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub




Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default code to color cell

Sub testcolor()

Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
End If
' On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.Find( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then

Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3"). _
Cells(Rows.Count, "a").End(xlUp).Offset(2)
'Rellenar filas

For Filas = Worksheets("Automatizacion A5,NB"). _
Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3"). _
Cells(Rows.Count, 5).End(xlUp).Offset(3).Resize(8)
Next
Else
Worksheets("Automatizacion A5,NB").Range("bi" & Fila). _
Interior.ColorIndex = 5
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub



"Israel" wrote:



With the following code i wanted him to shadow me the cell that i
doesn't find with blue color but not you where to place the it lines
of code, I believe that it is placed after the function else i would
thank Them a lot them to help me

Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub




Dim Origen As Range, Fila As Integer, Filas As Long
Fila = 8


Busca:
If Worksheets("Automatizacion A5,NB").Range("bi" & Fila) = "" Then
GoTo Salida
On Error Resume Next
With Worksheets("Proc.base")
Set Origen = .Cells.FIND( _
What:=Worksheets("Automatizacion A5,NB").Range("bi" & Fila), _
After:=.Range("bi3"), _
LookAt:=xlWhole)
If Not Origen Is Nothing Then
Origen.Resize(9).EntireRow.Copy _
Destination:=Worksheets("hoja3").Cells(Rows.Count,
"a").End(xlUp).Offset(2)
'Rellenar filas
For Filas = Worksheets("Automatizacion
A5,NB").Cells(Rows.Count, 1).End(xlUp).Row _
To 1 Step -1
Worksheets("Automatizacion A5,NB").Cells(Fila, 62).Copy _
Destination:=Worksheets("Hoja3").Cells(Rows.Count,
5).End(xlUp).Offset(3).Resize(8)
Next
Else
End If
End With
Fila = Fila + 1
GoTo Busca
Salida:
Set Origen = Nothing


End Sub


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Remove Cell Color after Code is Deleted [email protected] Excel Discussion (Misc queries) 4 February 20th 07 07:37 PM
Change the interior color of a cell - Code Review Tiny Tim Excel Programming 6 December 17th 05 09:49 PM
Cell Color Code Website EMoe[_15_] Excel Programming 1 May 29th 05 06:18 AM
how to color code a row of cells based on a specific cell value Parker1333 New Users to Excel 1 February 2nd 05 08:01 AM
Need help troubleshooting code which changes the color of a cell Larry Excel Programming 4 October 27th 04 06:29 PM


All times are GMT +1. The time now is 02:58 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"