Find, insert, Fill Down

[saru5133]

Hi,

All i am trying to do is find a word in the entire sheets, if found, insert a row, and drag down the formulae from previous cell to current cell.
if not found, leave blank
This is the code i am using. What mistake i am doing, I think related to the section highlighted in red.
Please correct me here.

Sub Average()

Dim r As Range
Dim i As Integer
Dim str As String

If Cells.Find(What:="Average", After:=activecell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate = True Then
Selection.EntireRow.Insert
str = Mid(Range("a:a" & activecell).Value, 9, 2)
Range("A" & activecell + 1).Value = "CW_2011_" & str + 1
Range("B" & 1 + activecell & ":C" & 1 + activecell).Copy Range("B" & 1 + activecell)
Cells.FindNext(After:=activecell).Activate
Else
End If
End Sub

[HansV]

If you refer to ActiveCell, you refer to its value. The cell you're looking for contains the word "Average". So for example ActiveCell + 1 is equivalent to "Average" + 1, which causes a type mismatch error because you're trying to add a string and a number.

Can you explain in more detail what exactly you're trying to copy?

[saru5133]

I am trying to copy the string CW_2011_ after inserting a line (ex:if previous line is CW_2011_25, next inserted cell should have value as CW_2011_26). once that string is filled down, it should go to search for another "Average" value.

[HansV]

Could you attach a small sample workbook that shows what it looks like before the macro has run, and what it should look like after the macro has run? Thanks in advance.

[saru5133]

Definitely...

pfa workbook
Given two sheets (before & after). After tab shows the fields (highlighted in yellow) it should be affected after code.

[HansV]

This is a bit tricky to program, because inserting a row immediately above the row with Average will not adjust the AVERAGE formula automatically. Rather than trying to modify the formula in the macro, I chose to insert a row one row up; because that row is within the range of the AVERAGE formula, Excel updates the formula correctly.

And you have to watch out for FindNext returning to the top. So I added a check for that.

Here are two slightly different versions that do the same; you can use either of them.

Code: Select all

Sub InsertAboveAverage()
    Dim lngVal As String
    Dim cel As Range
    Dim r As Long

    ' Find "Average"
    Set cel = Cells.Find(What:="Average", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not cel Is Nothing Then
        Do
            ' Store current row
            r = cel.Row
            ' Get the number at the end
            lngVal = Right(Range("A" & (r - 1)).Value, 2)
            ' Insert a row one up
            cel.Offset(-1, 0).EntireRow.Insert
            ' Fill the cells in column A.
            Range("A" & (r - 1)).Value = "CW_2011_" & lngVal
            Range("A" & r).Value = "CW_2011_" & (lngVal + 1)
            ' Fill the cells in columns B and C upwards
            Range("B" & (r - 1) & ":C" & r).FillUp
            ' Find next "Average"
            Set cel = Cells.FindNext(After:=cel.Offset(1, 0))
        ' Stop when we loop back to the top
        Loop Until cel.Row < r
    End If
End Sub

Sub InsertAboveAverage2()
    Dim cel As Range
    Dim r As Long

    ' Find "Average"
    Set cel = Cells.Find(What:="Average", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not cel Is Nothing Then
        Do
            ' Store current row
            r = cel.Row
            ' Insert a row one up
            cel.Offset(-1, 0).EntireRow.Insert
            ' Fill the cells in column A downwards
            Range("A" & (r - 2)).AutoFill Destination:=Range("A" & (r - 2) & ":A" & r)
            ' Fill the cells in columns B and C upwards
            Range("B" & (r - 1) & ":C" & r).FillUp
            ' Find next "Average"
            Set cel = Cells.FindNext(After:=cel.Offset(1, 0))
        ' Stop when we loop back to the top
        Loop Until cel.Row < r
    End If
End Sub

[saru5133]

sorry, took little time to come back..

Thanks. It is working absolutly fine as per my requirment.
I tried modifying the code as given below.

Code: Select all

Sub InsertAboveAverage()
    Dim lngVal As String
    Dim cel As Range
    Dim r As Long

    ' Find "average"
    Set cel = Cells.Find(What:="average", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not cel Is Nothing Then
        Do
            ' Store current row
            r = cel.Row
            ' Get the number at the end
            lngVal = Right(Range("C" & (r - 1)).Value, 2)
            ' Insert a row one up
            cel.Offset(-1, 0).EntireRow.Insert
            ' Fill the cells in column C & U
            Range("C" & (r - 1)).Value = "CW_2011_" & lngVal
            Range("U" & (r - 1)).Value = "CW_2011_" & lngVal
            Range("C" & r).Value = "CW_2011_" & (lngVal + 1)
            Range("U" & r).Value = "CW_2011_" & (lngVal + 1)
            ' Fill the cells in columns D to L and V to AF upwards
            Range("D" & (r - 1) & ":E" & "F" & (r - 1) & ":G" & r).FillUp
            'Range("D" & "V" & (r - 1) & ":E" & ":W" & r).FillUp
            ' Find next "Average"
            Set cel = Cells.FindNext(After:=cel.Offset(1, 0))
        ' Stop when we loop back to the top
        Loop Until cel.Row < r
    End If
End Sub

But, am getting an error (document attached). What does this mean

[HansV]

I'd have to see the workbook - apparently the structure of the worksheet it different from the one you posted higher up in this thread.

By the way, the line

Range("D" & (r - 1) & ":E" & "F" & (r - 1) & ":G" & r).FillUp

doesn't look correct. What exactly are you trying to accomplish with it?

[saru5133]

I agree,WB is actually different from the test file i uploaded and actual file size is too big to upload.

With the above code line am trying to drag down formulae from above rows to down in the entire row
(Column D to L & V to AF)

[HansV]

Try

Range("D" & (r - 1) & ":L" & r).FillUp
Range("V" & (r - 1) & ":AF" & r).FillUp

BTW, the screenshot in your document shows that column C contains an error value. You'll have to find out why...

[saru5133]

It could be that, in few places of work book, i have given cell reference (Ex:=c29) instead of doing adjustement each n every time.

Is that can be a reason for that error?

[HansV]

If you look at column C, do you see an error value, e.g. #N/A or #REF! or #DIV/0! in any of the cells?