CODEWITHSUNDEEP
vbaexcel
gksdmsgP
gksdmsgP

Reputation: 17

looping through each COLUMN and finding highlighted cell

I am having difficulty looping through each column before looping through the next row. The number of columns is fixed (A:K) with an unknown number of rows. The goal is to find highlighted cells (no distinct color.. and I figured the best way to do this is to code "If Not No Fill") and copy that whole row to another workbook. This is what I have so far and I am stuck:

Option Explicit
Sub Approval_Flow()
Dim AppFlowWkb As Workbook, ConfigWkb As Workbook
Dim AppFlowWkst As Worksheet, ConfigWkst As Worksheet
Dim header As Range, headerend As Range
Dim row As Long, column As Long

Set AppFlowWkb = Workbooks.Open("C:\Users\clara\Documents\Templates and Scripts\Approval Flow Change Log.xlsx")
Set ConfigWkb = ThisWorkbook
Set AppFlowWkst = AppFlowWkb.Sheets("Editor")
Set ConfigWkst = ConfigWkb.Worksheets("Approval Flows")

With ConfigWkb
    Set header = Range("A7").Cells
    If Not header Is Nothing Then
        Set headerend = header.End(xlDown).row
    For row = 7 To headerend
        For j = 1 To 11
            'if cell is filled (If Not No Fill), copy that whole row to another workbook

End With


End Sub

I am getting an error with the Set headerend line, but I am trying to select the last row to use it in my for loop. I appreciate any help and guidance. Thanks in advance!

Upvotes: 0

Views: 68

Answers (2)

Wolfie
Wolfie

Reputation: 30047

You should be able to adapt this to suit your workbooks, see the comments for details

Dim aCell as Range
' Use UsedRange to get the variable number of rows, 
' cycle through all the cells in that range
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.UsedRange.Rows.Count)
    ' Test if fill colour is white (none)
    If Not aCell.Interior.Color = RGB(255,255,255) Then
        ' Insert new row in target sheet (could find last row instead)
        ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1").EntireRow.Insert
        ' Paste entire row into target sheet
        aCell.EntireRow.Copy Destination:=ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1")
    End If
Next aCell

Alternatively to find the last row, if you know the range is continuous (no blanks) then you can use End(xlDown) like you had done, and like below

For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.Range("K1").End(xlDown))

I'd guess you don't want to copy the same row multiple times if you've already copied it. You could do this by keeping an array or string with previously copied row numbers and checking before copying again, or use Excel's unique functions to strip the list down after copying.

Hope this helps.

Aside:

You're using a With block but not taking advantage of it, you need to put a dot . before your Range objects to specify that they're in your With sheet. Like so

Dim myRange as Range
With ActiveSheet
    Set myRange = .Range("A1:C10")
End With

Upvotes: 0

BruceWayne
BruceWayne

Reputation: 23283

You're mixing the types.

It looks like you just want to use the Row that the Header data ends on.

Take out the .Row there, since you're setting headerend to be a cell address, not a specific value. Then change For row = 7 To headerend to For row = 7 To headerend.Row

Or, change Dim Headerend as Range to ...as Long and just do headerEnd = header.End(xlDown).Row (don't use Set)

Upvotes: 0

Related Questions