VBA: Looped code doesn't populate correct cells on certain sheets

[suremac]

Greetings,

The code below works correctly on certain sheets. The code is supposed to calculate the percent change from 1990 to 2012 and from 2005 to 2012, and put the calculations on the 4th and 5th row from the last non-empty row, respectively. All the sheets are identical except for 3. The sheets that are different only have a different number of years of data. For some reason this causes the macro to put the percent change calculations in random rows below the correct location. Also, the macro doesn't work correctly on one of the identical sheets. I have no idea why.

Sub PercentChangeCalPIP()
    Dim iRow As Long
    Dim sheet_name As Range
    For Each sheet_name In Sheets("WS").Range("I:I")
        If sheet_name.Value = "" Then
            Exit For
        Else
        With Sheets(sheet_name.Value)
    '90-20## Percent Change
    iRow = 14
    Cell_val = .Cells(iRow, 1)
    While Cell_val <> ""
        iRow = iRow + 3
        Cell_val = .Cells(iRow, 1)
    Wend
    .Cells(iRow + 3, 1) = "1990-2012"
    'Column B,2
   
    Cell_val = .Cells(iRow, 2)
    While Cell_val <> ""
        iRow = iRow + 3
        Cell_val = .Cells(iRow, 2)
    Wend
    .Cells(iRow + 3, 2) = "=((B14/VLOOKUP(1990, A14:B46, 2,FALSE))-1)"
    'Column C,3
   
    Cell_val = .Cells(iRow, 3)
    While Cell_val <> ""
        iRow = iRow + 3
        Cell_val = .Cells(iRow, 3)
    Wend
    .Cells(iRow + 3, 3) = "=((C14/VLOOKUP(1990, A14:C46, 3,FALSE))-1)"
    'Column D,4
   
    Cell_val = .Cells(iRow, 4)
    While Cell_val <> ""
        iRow = iRow + 3
        Cell_val = .Cells(iRow, 4)
    Wend
    .Cells(iRow + 3, 4) = "=((D14/VLOOKUP(1990, A14:D46, 4,FALSE))-1)"
    'Column E,5
   
    Cell_val = .Cells(iRow, 5)
    While Cell_val <> ""
        iRow = iRow + 3
        Cell_val = .Cells(iRow, 5)
    Wend
    .Cells(iRow + 3, 5) = "=((E14/VLOOKUP(1990, A14:E46, 5,FALSE))-1)"
    '05-20## Percent Changes
    Cell_val = .Cells(iRow, 1)
    While Cell_val <> ""
        iRow = iRow + 4
        Cell_val = .Cells(iRow, 1)
    Wend
    .Cells(iRow + 4, 1) = "2005-2012"
    'Column B,2
   
    Cell_val = .Cells(iRow, 2)
    While Cell_val <> ""
        iRow = iRow + 4
        Cell_val = .Cells(iRow, 2)
    Wend
    .Cells(iRow + 4, 2) = "=((B14/VLOOKUP(2005, A14:B46, 2,FALSE))-1)"
    'Column C,3
   
    Cell_val = .Cells(iRow, 3)
    While Cell_val <> ""
        iRow = iRow + 4
        Cell_val = .Cells(iRow, 3)
    Wend
    .Cells(iRow + 4, 3) = "=((C14/VLOOKUP(2005, A14:C46, 3,FALSE))-1)"
    'Column D,4
   
    Cell_val = .Cells(iRow, 4)
    While Cell_val <> ""
        iRow = iRow + 4
        Cell_val = .Cells(iRow, 4)
    Wend
    .Cells(iRow + 4, 4) = "=((D14/VLOOKUP(2005, A14:D46, 4,FALSE))-1)"
    'Column E,5
   
    Cell_val = .Cells(iRow, 5)
    While Cell_val <> ""
        iRow = iRow + 4
        Cell_val = .Cells(iRow, 5)
    Wend
    .Cells(iRow + 4, 5) = "=((E14/VLOOKUP(2005, A14:E46, 5,FALSE))-1)"
    End With
            End If
        Next sheet_name
    End Sub

Any thoughts as to what might be the problem? Thank you very much for your help!

 

[StephenCrump]

Your code won't necessarily find the last non-empty row. Instead, you have hard-coded that for each column, you loop through the rows in steps of 3, and later 4, until you find a blank cell. Your loop counter, iRow, is hard coded to start at Row 14. However, you use the same counter, iRow, in all your While loops, and this counter is never reset. So depending on what's in each sheet, you may get very different, and apparently random, placement of your headings and formulae.

Is there anything in the sheets below where you want to insert your headings and formulae? If you really do want to identify the last non-blank row, a simple:

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'assuming you can rely on Column A

could replace all this looping?

 

[suremac]

There are technical data notes located below the two rows of percent change calculations, so unfortunately

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

didn't quite work. I fixed most the the problem sheets with the below code. However, the code is still giving me trouble on one of the sheets. For some reason on that one sheet it creates duplicate percent change calculations and puts them where I have the technical notes. Any thoughts? Could the sheet formatting be causing the problem?

Sub PercentChangeCalPIP()
    Dim iRow As Long
    Dim sheet_name As Range
    For Each sheet_name In Sheets("WS").Range("I:I")
        If sheet_name.Value = "" Then
            Exit For
        Else
            With Sheets(sheet_name.Value)
                '90-20## Percent Change
                iRow = .Cells(14, 1).End(xlDown).Row
                .Cells(iRow + 4, 1).Value = "1990-2012"
                'Column B,2
                .Cells(iRow + 4, 2).Formula = "=((B14/VLOOKUP(1990, A14:B" & iRow & ", 2,FALSE))-1)"
                'Column C,3
                .Cells(iRow + 4, 3).Formula = "=((C14/VLOOKUP(1990, A14:C" & iRow & ", 3,FALSE))-1)"
                'Column D,4
                .Cells(iRow + 4, 4).Formula = "=((D14/VLOOKUP(1990, A14:D" & iRow & ", 4,FALSE))-1)"
                'Column E,5
                .Cells(iRow + 4, 5).Formula = "=((E14/VLOOKUP(1990, A14:E" & iRow & ", 5,FALSE))-1)"
                '05-20## Percent Changes
                .Cells(iRow + 5, 1).Value = "2005-2012"
                'Column B,2
                .Cells(iRow + 5, 2).Formula = "=((B14/VLOOKUP(2005, A14:B" & iRow & ", 2,FALSE))-1)"
                'Column C,3
                .Cells(iRow + 5, 3).Formula = "=((C14/VLOOKUP(2005, A14:C" & iRow & ", 3,FALSE))-1)"
                'Column D,4
                .Cells(iRow + 5, 4).Formula = "=((D14/VLOOKUP(2005, A14:D" & iRow & ", 4,FALSE))-1)"
                'Column E,5
                .Cells(iRow + 5, 5).Formula = "=((E14/VLOOKUP(2005, A14:E" & iRow & ", 5,FALSE))-1)"
            End With
        End If
    Next sheet_name
End Sub

 

[StephenCrump]

I think the issue is whether the following line will always find the right row, i.e. in every possible sheet configuration?

iRow = .Cells(14, 1).End(xlDown).Row

In the offending sheet, if you go to A14, press CTL-Down arrow and step down 4-5 rows, are you in the technical notes section?

If that's the problem, perhaps there are better alternatives, e.g. could you find the row number of the technical notes section by locating a standard header "Technical Notes", say, and then step up N rows?

Also, will there always be room, or should your code allow for the possibility of needing to insert rows?

I can't see how your code will produce duplicate results, even if the sheet name has been duplicated in WS!I:I. Is there a possibility that these have been left in the wrong place from a previous run of incorrect code?

If you're still having problems, it would be useful if you could post a screenshot of the sheet causing the trouble.