CODEWITHSUNDEEP
vbaexcelexcel-2010
dashton
dashton

Reputation: 43

Excel VBA Writing Data Outside of UsedRange

I have been working on code to calculate the percentage of complete pipes opposed to incomplete pipes in excel spreadsheets, here is the code:

Sub PercentCompletePipes()
Dim k As Range
Dim Counter As Integer
Dim Green As Integer
Dim Red As Integer
Red = 0
Green = 0
Counter = 0
xTitleId = "Percentage Completed Inverts"
MsgBox "This macro defines the percentage of pipes with completed inverts.  It ignores all PRIVATE pipes."
MsgBox "WARNING: This macro only works with COMPLETED invert excel sheets.  Please select the row that you would like to display the data in, and highlight it yellow."
For Each k In ActiveSheet.UsedRange.Rows
    If Counter >= 4 Then
        If ActiveSheet.Cells(k.Row, 1).Interior.ColorIndex = 4 Then
            Green = Green + 1
        ElseIf ActiveSheet.Cells(k.Row, 1).Interior.ColorIndex = 3 Then
            Red = Red + 1
        ElseIf ActiveSheet.Cells(k.Row, 1).Interior.ColorIndex = 6 Then
            ActiveSheet.Cells(k.Row, 1).Value = "COMPLETED PIPES:"
            ActiveSheet.Cells(k.Row, 4).Value = Green
            ActiveSheet.Cells(k.Row + 1, 1).Value = "INCOMPLETE PIPES:"
            ActiveSheet.Cells(k.Row + 1, 4).Value = Red
            ActiveSheet.Cells(k.Row + 2, 1).Value = "PERCENTAGE COMPLETE:"
            ActiveSheet.Cells(k.Row + 2, 4).Value = (Green / (Red + Green)) * 100
            ActiveSheet.Cells(k.Row + 2, 5).Value = "%"
            ActiveSheet.Cells(k.Row + 3, 1).Value = "NOTE: These values do not account for PRIVATE pipes."
        End If
    End If
    Counter = Counter + 1
Next k




End Sub

As you can see this code will do what I mentioned earlier, albeit only after I have found the cell after the last row with data in it, and highlighted it yellow. Since I have hundreds of sheets to do this for, it is extremely tedious, and I'd instead rather make it find this cell itself. However, this blank cell is outside of the UsedRange in excel, thus my previous attempts at making this possible have failed since the code doesn't seem to work past the used range. Here is a picture of the sheet that I am trying to achieve this on, as you can see I have highlighted the cell outside of the used range yellow for the code to work. My excel file. Also, I cannot simply make the code look for the first "empty" (white, blank) row to put data in since 2 rows at the beginning are format separators, and are meant to stay blank. Any help is appreciated, let me know if you have any questions. Thanks!

Upvotes: 0

Views: 446

Answers (2)

user6432984
user6432984

Reputation:

The pattern that I like to use to select target the first row after the last used row is .Range("A" & .Rows.Count).End(xlUp).Offset(1). You Flephal pointed out, it is dependent on the first cell in the last used row having data.

enter image description here

Sub DemoPercentCompletePipes()
    PercentCompletePipes ActiveSheet
End Sub

Sub PercentCompletePipes(ws As Worksheet)
    Dim cell As Range
    Dim Counter As Integer, Green As Integer, Red As Integer

    xTitleId = "Percentage Completed Inverts"
    MsgBox "This macro defines the percentage of pipes with completed inverts.  It ignores all PRIVATE pipes."
    MsgBox "WARNING: This macro only works with COMPLETED invert excel sheets.  Please select the row that you would like to display the data in, and highlight it yellow."

    With ws
        'Define target range starting at "A4" and extending to the last used cell in column A
        With .Range("A4", .Range("A" & .Rows.Count).End(xlUp))

            For Each cell In .Cells
                If cell.Interior.ColorIndex = 4 Then
                    Green = Green + 1
                ElseIf cell.Interior.ColorIndex = 3 Then
                    Red = Red + 1
                End If
            Next
        End With

        'Target the next empty row in Column A
        With .Range("A" & .Rows.Count).End(xlUp).Offset(1).EntireRow
            .Cells(1, 1).Value = "COMPLETED PIPES:"
            .Cells(1, 4).Value = Green
            .Cells(2, 1).Value = "INCOMPLETE PIPES:"
            .Cells(2, 4).Value = Red
            .Cells(3, 1).Value = "PERCENTAGE COMPLETE:"
            .Cells(3, 4).Value = (Green / (Red + Green)) * 100
            .Cells(3, 5).Value = "%"
            .Cells(4, 1).Value = "NOTE: These values do not account for PRIVATE pipes."
        End With
    End With
End Sub

Data extracted using Online OCR

Upvotes: 1

Tragamor
Tragamor

Reputation: 3634

Consider the following:

Sub Foo1()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim Rng As Range: Set Rng = Application.Intersect(ws.Range("A:A"), ws.UsedRange)
    Set Rng = Application.WorksheetFunction.Index(Rng, Rng.Count).Offset(1, 0)
    Rng.Select
End Sub

Finds the last Cell in column 'A' within the UsedRange then offsets by 1 row.

Upvotes: 1

Related Questions