Mike Kellogg
Mike Kellogg

Reputation: 1178

Effective Looping Checkup VBA

Summary: My company has two different spreadsheets with many policies on each. They want me to match up policies by a policy ID and transfer all the old notes from the old spreadsheet to the new spreadsheet.

Reasoning: my issue is not with not understanding how to do this, but the BEST way to do this. Since joining StackOverflow I've been told things I should and shouldn't do. I've been told different times it is better to use a For Each loop instead of a simple Do loop. Also, I've been told I shouldn't use .Select heavily (but I do).

How I Would Normally Do It: I would normally just use a Do Loop and go through the data just selecting the data with .Find and using ActiveCell and when I wanted to interact with other Columns in that current row I would just use ActiveCell.Offset(). I tend to love .Select and use it all the time, however on this project I'm trying to push myself out of the box and maybe change some bad coding habits and start using what may be better.

Question: How would I go about doing the equivalent of an ActiveCell.Offset() when I'm using a For Each loop?

My Code So Far: **Questions/Criticisms welcome

Sub NoteTransfer()

    transferNotes

End Sub
Function transferNotes()

    Dim theColumn As Range
    Dim fromSheet As Worksheet
    Dim toSheet As Worksheet
    Dim cell As Range
    Dim lastRow As Integer

    Set fromSheet = Sheets("NotesFrom")
    Set toSheet = Sheets("NotesTo")

    With fromSheet                      'FINDING LAST ROW
        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    End With

    Set theColumn = fromSheet.Range("B5:B" & lastRow)

    For Each cell In theColumn          'CODE FOR EACH CELL IN COLUMN

        If cell.Text = "" Then

            'do nothing

        Else

            With toSheet         'WANT TO FIND DATA ON THE toSheet

                Cells.find(What:=cell.Text, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate



            End With


        End If

    Next cell

End Function

Example

Example Picture for reference's sake

Bottom of the sheet

Bottom of the Sheet.

Upvotes: 0

Views: 312

Answers (2)

Scott Holtzman
Scott Holtzman

Reputation: 27259

First, your question:

Question: How would I go about doing the equivalent of an ActiveCell.Offset() when I'm using a For Each loop?

Doesn't make much sense given the code you posted. It's a very general question, and would need some context to better understand. It really depends on your loop. If you are looping a contiguous range of cells from the ActiveCell then you could say ...

For each cel in Range
    myValue = ActiveCell.Offset(,i)
    i = i + 1
Next

To get the column next to each cell in the loop. But in general I wouldn't call that great programming. Like I said, context is important.

As far as your code goes, see if this makes sense. I've edited and commented to help you a bit. Oh yeah, good job not using Select!

Sub transferNotes() '-> first no need for a function, because you are not returning anything...
                       'and no need to use a sub to call a sub here as you don't pass variables,
                       'and you don't have a process you are trying to run

    Dim theColumn As Range, cell As Range '-> just a little cleaner, INMHO
    Dim fromSheet As Worksheet, toSheet As Worksheet '-> just a little cleaner, INMHO
    Dim lastRow As Integer

    Set fromSheet = Sheets("NotesFrom")
    Set toSheet = Sheets("NotesTo")

    With fromSheet ' -> put everything you do in the "fromSheet" in your With block

        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row 'FINDING LAST ROW
        Set theColumn = .Range("B5:B" & lastRow)

        theColumn.AutoFilter 1, "<>"

        Set theColumn = theColumn.SpecialCells(xlCellTypeVisible) '-> now you are only looping through the cells are that are not blank, so it's more efficient

        For Each cell In theColumn

            '-> use of ActiveCell.Offset(), it's not ActiveCell.Offset(), but it uses Offset
            Dim myValue
            myValue = cell.Offset(, 1) '-> gets the cell value in the column to the right of the code


            'WANT TO FIND DATA ON THE toSheet
            toSheet.Cells.Find(What:=cell.Text, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate

        Next cell

    End With

End Sub

Upvotes: 2

Brad
Brad

Reputation: 12253

This is my suggestion so far.

Function transferNotes()

    Dim SourceColumn As Range
    Dim fromSheet As Worksheet
    Dim toSheet As Worksheet
    Dim cell As Range
    Dim lastRow As Long '<--changed to Long

    Set fromSheet = Sheets("NotesFrom")
    Set toSheet = Sheets("NotesTo")

    With fromSheet                      'FINDING LAST ROW
        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    End With

    Set SourceColumn = fromSheet.Range("B5:B" & lastRow)

    For Each cell In SourceColumn          'CODE FOR EACH CELL IN COLUMN
        If cell.Value = "" Then 'the .Text property can
                                'make for some confusing errors.
                                'Try to avoid it.
            'nothng to search for
        Else
            With toSheet         'WANT TO FIND DATA ON THE toSheet
                Dim destRng As Range

                Set destRng = .Range("A:A").Find(What:=cell.Value)
                If Not destRng Is Nothing Then
                    .Cells(destRng.Row, <your mapped column destination>)
                        = fromSheet.Cells(cell.Row,<your mapped column source>)
    ' you can either repeat the above line for all of your non-contiguous
    'sections of data you want to move from sheet to sheet
    '(i.e. if the two sheets are not arranged the same)
    'if the two sheets are aranged the same then change
    'the .cells call to call a range and include
    'the full width of columns
                Else
                    'nothing was found
                End If

            End With
        End If
    Next cell

End Function

Upvotes: 1

Related Questions