Question

I have a case at the moment where I am moving down the column with the names below and clicking on a macro, that then marks the indicator with a 35, a few columns down to the right. Due to the nature of the page, I am wanting to count how far down the list I am when I review a name and activate the macro. So what I want to do is instead of just selecting and marking the one name I want to mark that row and all preceding rows with a 35. That way the graphs and calculated COUNTA value changes with the progress of the reviewer as he/she goes down the sheet.

         Totals X   Y   Z   T   Marker  Indicator
TOM     xxxxxxx xxxxxxx xxxxxxx xxxxxxx     35
HARRY   xxxxxxx xxxxxxx xxxxxxx xxxxxxx     
PAUL    xxxxxxx xxxxxxx xxxxxxx xxxxxxx     
PETER   xxxxxxx xxxxxxx xxxxxxx xxxxxxx     35
TIM     xxxxxxx xxxxxxx xxxxxxx xxxxxxx

My scripts for the macro is the following:

Sub tester2()
Set Rng = ActiveCell
'
' tester2 Macro
'

'
    ActiveCell.Offset(0, 6).Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0

        ActiveCell.Value = 35

        Application.Goto Rng

    End With
End Sub

Then as an FYI, my export macro which is only supposed to export line items that are manually highlighted (Not the automatically filled preceeding ones).

Sub export()

Dim cell As Range
Dim lastRow As Long, i As Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("G1:G" & lastRow)
    If cell.Value = 35 Then
        cell.EntireRow.Copy Sheets(2).Cells(i, 1)
        i = i + 1
    End If
Next

End Sub

So what I have thought is, is it possible to, for my first macro, be able to have the one marker (35) at 6 columns to the right. Have all preceding rows markerd too, then maybe just a marker in the 7th column for that row. That way my calculated row count runs off the new column 6. And my export off column number 7.

Answer 1

This can be simplified pretty easily to affect the cells from 2 to the current row, six columns to the right-

Sub tester2()

Dim col As Integer
col = ActiveCell.Column + 6
Dim row As Integer
row = ActiveCell.row
Dim rng As Range
Set rng = Range(Cells(2, col), Cells(row, col))

   For Each c In rng
   With c
        .Interior.Pattern = xlSolid
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 65535
        .Interior.TintAndShade = 0
        .Interior.PatternTintAndShade = 0
        .Value = 35
    End With
    Next
End Sub

If you wanted it to notate where the last export was, you could add in something like -

ActiveCell.Offset(, 7) = "export"
Range(Cells(1, col + 1), Cells(row - 1, col + 1)).Clear

Range, Select, Change contents, Alignment or Offset?

1 个答案: