VBA code required

[Damo10]

Hi,

I am looking for some code that will go through all the rows starting at cell E20 and execute the code that I have written if it meets the criteria then move to the next row until it finds the last populated row then move to the next column and repeat, it would then do this until it finds the last populated column.

There are currently 1100 rows and 70 columns in my sheet and need each cell to be checked.

Hope someone can help

Regards Damian

 

[Myproblem]

Dim rng As Range, startCell As Range, rng2 As Range
Dim celAddress$, cel As Range, x#
Set rng = Range([E20], Cells(Rows.Count, Columns.Count))
Set startCell = rng.Cells(1)
Do
    Set cel = rng.Find(What:="a", After:=startCell, _
        LookIn:=xlValues, LookAt:=xlWhole)
    If cel Is Nothing Then Exit Do
    If x = 0 Then
        celAddress = cel.Address
        If Cells(cel.Row, "C") <= Date Then Set rng2 = cel
        x = 1
    Else
        If cel.Address = celAddress Then Exit Do
        If Cells(cel.Row, "C") <= Date Then Set rng2 = Union(cel, rng2)
    End If
    Set startCell = cel
Loop
rng2 = "h"

I have similar problem:
I need to fill empty rows below with the value from the row above empty row, like
A B C
1 12 10 ABC
2
3
4 100 CCC 15
5
6
....
5500

so solution should be in column A for rows 2 and 3 12 in both A2 i A3 cells,
for A5 i A6 cells the value should be 100, same apply to the columns B and C
any solutions

 

[AlanAnderson]

Hi Damian,

My suggestion is not elegant and is probably not the best way but it works for me.
I have set up simple source page containing columns with random numbers.
For test purposes my criteria is set to look for any cell where cell value = 3 (Obviously you would substiture your own criteria here)
If my criteria is met I am simply copying the cell to a target page (Once again you would do what you need instead)


Hope this helps,

Regards,

Alan

Sub FindAndCopy()
    Dim FinalRowS As Long
    Dim FinalColS As Long
    Dim FinalRowT As Long
    Dim wsT As Worksheet
    Dim wsS As Worksheet
    Dim x As Long
    Dim y As Long
 
    Set wsS = Worksheets("Source")
    Set wsT = Worksheets("Target")
    x = 1
    FinalRowS = wsS.Cells(Rows.Count, x).End(xlUp).Row
    FinalColS = wsS.Cells(Columns.Count).End(xlToLeft).Column
 
        For a = 1 To FinalColS
            For b = 1 To FinalRowS
                FinalRowT = wsT.Cells(Rows.Count, 1).End(xlUp).Row
                    If wsS.Cells(b, a) = 3 Then
                        wsT.Cells(FinalRowT + 1, 1) = wsS.Cells(b, a)
                        FinalRowT = wsT.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    End If
            Next b
        Next a
End Sub

 

[Boller]

Dim rng As Range, startCell As Range, rng2 As Range
Dim celAddress$, cel As Range, x#
Set rng = Range([E20], Cells(Rows.Count, Columns.Count))
Set startCell = rng.Cells(1)
Do
    Set cel = rng.Find(What:="a", After:=startCell, _
        LookIn:=xlValues, LookAt:=xlWhole)
    If cel Is Nothing Then Exit Do
    If x = 0 Then
        If Cells(cel.Row, "C") <= Date Then
            Set rng2 = cel
            celAddress = cel.Address
            x = 1
        End If
    Else
        If cel.Address = celAddress Then Exit Do
        If Cells(cel.Row, "C") <= Date Then Set rng2 = Union(cel, rng2)
    End If
    Set startCell = cel
Loop
If Not rng2 Is Nothing Then rng2 = "h"

 

[Boller]

To Myproblem :-

http://www.mrexcel.com/forum/showthread.php?t=536232&highlight=fill+blank+cells

This can also be done easily without VBA.

 

[Myproblem]

To Myproblem :-

http://www.mrexcel.com/forum/showthread.php?t=536232&highlight=fill+blank+cells

This can also be done easily without VBA.

thx man, it is it, it works

 

[Damo10]

Hi,

I am still having problems with this code as it crashes excel.

Regards

 

[Boller]

Hi,

I am still having problems with this code as it crashes excel.

Regards

Strange. It works for me.

 

[AlanAnderson]

Hi Damian,

The suggestion made by Boller seems good to me. I know the alternative I suggested works (might not be elegant though).

Perhaps the problem lies within your data?

Regards,

Alan

 

[AlanAnderson]

Hi Damian, A further thought.... is your programme crashing in BOTH 2007 and 2010?

Regards,

Alan

 

[Boller]

Have you tried stepping through the code via F8 to find where the problem is arising?