PDA

View Full Version : help, a system to check inventories



lombardo73
04-13-2016, 03:55 PM
Hi everybody, i'm a newbie in vba, i learned a bit checking examples on internet.
Now i'm making a "system" to check inventories in tables.
I have a list of codes with their respective stock, also in the other sheets i have tables with descriptions of the products with their respective code.
my macro must check if there is a code with stock in each sheet of the book and put a color in the cell, also put the stock on the right of the table.
Actually my macro works, but I have about 700 sheets that must be coloured and i think my macro isn't efficient because it works with less sheets (about 10-20, but when i use it with my big book, my pc freezes:banghead:)
So, can you help me to improve the code?

Sorry for my bad english, i'm trying to improve it.



Sub agregarstock()
'checkrojo
Dim ws As Worksheet
Dim c As Range
Dim cod As Range
Dim codstock As Range
Dim colustock As Range
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "Hoja*" Then 'si la hoja se llama como hoja algo no la considera
'nothing
Else
checkrojo
'borrarstockpasado
Worksheets("Hoja2").Select 'selecciona la hoja 2
Set rango = Sheets("Hoja2").Range("B2") 'crea la variable rango para la columna de los codigos
Set rango = Range(rango, rango.End(xlDown))
For Each cod In rango 'hace barrido en columna de codigos
Set codstock = cod.Offset(0, 2) 'en cada item saca su stock en codstock
ws.Select 'selecciona la hoja de catalogo
ws.Range("A3").Select 'ubica el punto inicial de la hoja catalogo y selecciona todo
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
With Selection
Set c = .Find(cod.Value, LookIn:=xlValues) 'busca el valor del codigo en la tabla
If c Is Nothing Then
'nothing pe... no encontro nada
Else
If c.Interior.Color = RGB(255, 255, 255) Then '#######aqui esta el testing para el check de colores por novedad, retiro y renovado
c.Interior.Color = RGB(146, 208, 80) 'si es blanco, entoncs verde
ElseIf c.Interior.Color = RGB(255, 0, 0) Then
c.Interior.Color = RGB(0, 176, 240) 'si es rojo, entoncs azul
Else
'nothing pe
End If
'c.Interior.ColorIndex = 24 'si lo encuentra, lo pinta de morado
Set colustock = c.End(xlToRight).Offset(0, 1) 'se ubica en el punto mas a la derecha de esa fila
colustock.Value = codstock 'asigna el valor del stock

End If
End With
Next cod 'pasa al siguiente codigo de la lista de stocks
End If
Next ws 'pasa a la siguiente hoja
End Sub



Sub checkrojo()
Dim tcelda As Range
Dim tcolor As Long
Dim rango As Range
Dim ws As Worksheet
Dim tope As Range


'For Each ws In ThisWorkbook.Worksheets
'ws.Select
Range("A3").Select 'ubica el punto inicial de la hoja catalogo y selecciona todo
Set rango = Range(Selection, Selection.SpecialCells(xlLastCell))
For Each tcelda In rango
tcolor = tcelda.Interior.Color

If tcolor = RGB(155, 194, 230) Then 'no hace nada con los header
'nothing pe
ElseIf tcolor = RGB(255, 255, 255) Then 'no hace nada con blancos
'nothing pe
Else
tcelda.Interior.ColorIndex = 3 'colorea en rojo cualquier otro color
End If

'#########PART QUE ELIMINA LOS STOCKS PASADOS##########
If tcelda.Value Like "*Precio*" Then
columna = tcelda.Column + 1
Set tope = Cells(1, columna)
Range(tope, tope.SpecialCells(xlLastCell)).Select
Selection.Delete
Else
'nada pe
End If
'######################################################

Next tcelda
'Next ws
End Sub

SamT
04-14-2016, 03:43 AM
Sub agregarstock()
'checkrojo
Dim ws As Worksheet
Dim c As Range
Dim cod As Range
Dim codstock As Range
Dim colustock As Range
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "Hoja*" Then 'si la hoja se llama como hoja algo no la considera
'nothing
Else
checkrojo ws
'
'
'


Sub checkrojo(ws As worksheet)
Dim tcelda As Range
Dim tcolor As Long
Dim rango As Range
'''Dim ws As Worksheet
Dim tope As Range


''''''For Each ws In ThisWorkbook.Worksheets
''''''ws.Select
With ws
Range("A3").Sel. . .

SamT
04-14-2016, 03:53 AM
Colored cells = big slowdown.

RGB Colored cells = very big slowdown.

Better to use Excel menu Tools >> Options >> Colors to modify a ColorIndex color as desired.


Sub ShowMeColorIndices()
With ActiveSheet.Range("A:A")
For i = 1 To 56
With .Cells(i)
.Value = i
.Interior.ColorIndex = i
End With
Next i
End With