Struggling to get the Loop to work

Hello everyone,

Imagine if I have more than one row with the current date. My macro works for one row but I want it to work for multiple rows, how can I fix it, here is the code.

    Sub SelectingPartOfTable()

    Workbooks.Open Filename:="Y:\Guinness\Error Log\NBCGF Event Log.xlsm"
    Dim i As Integer
    
    Workbooks("Risk").Activate
    Sheets("Sheet1").Select
    
    For i = 1 To 100
    
    If Cells(i, 2) = Date Then
    
    Cells(i, 2).EntireRow.Select
    Selection.Copy
    
    Workbooks("NBCGF Event Log").Activate
    Sheets("NBCGF Error Log").Select
    
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A2").Select
    ActiveSheet.Paste
    
    End If
    
    Next i
    
End Sub

The technical answer to your question is; after the first iteration of your loop the active worksheet is changed and the code within the loop incorrecly functions on the active workbook/worksheet.

Originally Posted by stnkynts

The technical answer to your question is; after the first iteration of your loop the active worksheet is changed and the code within the loop incorrecly functions on the active workbook/worksheet.

Perfect example of why you should avoid using Select and Activate!

Thank you for your reply, it looks brilliant. I'm getting an error though, here is the code:

Sub SelectingPartOfTable()

    Dim wbErrorLog As Workbook
    Dim wsErrorLog As Worksheet
    Dim wsRisk As Worksheet
    Dim i As Integer

    Set wbErrorLog = Workbooks.Open Filename:="Y:\Guinness\Error Log\NBCGF Event Log.xlsm"
    Set wsErrorLog = wbErrorLog.Sheets("NBCGF Error Log")
    Set wsRisk = Workbooks("Risk").Sheets("Sheet1")
    
    For i = 1 To 100
        If wsRisk.Range("b" & i) = Now() Then
            wsRisk.Range("b" & i).EntireRow.Copy
            With wsErrorLog.Range("a2").EntireRow
                .Insert Shift:=xlDown
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next
    
End Sub

It highlights Filename and says

Compile error:

Expected: end of statement

Any ideas?

ok, Replace this line:

Set wbErrorLog = Workbooks.Open Filename:="Y:\Guinness\Error Log\NBCGF Event Log.xlsm"

with this line:

Set wbErrorLog = Workbooks.Open("Y:\Guinness\Error Log\NBCGF Event Log.xlsm")

And see if that works.

This works

Sub SelectingPartOfTable()

    Dim wbErrorLog As Workbook
    Dim wsErrorLog As Worksheet
    Dim wsRisk As Worksheet
    Dim i As Integer

    Set wbErrorLog = Workbooks.Open("Y:\Guinness\Error Log\NBCGF Event Log.xlsm")
    Set wsErrorLog = wbErrorLog.Sheets("NBCGF Error Log")
    Set wsRisk = Workbooks("Risk").Sheets("Sheet1")
    
    For i = 1 To 100
        If wsRisk.Range("b" & i) = Date Then
            wsRisk.Range("b" & i).EntireRow.Copy
            With wsErrorLog.Range("a2").EntireRow
                .Insert Shift:=xlDown
            End With
        End If
    Next
    
End Sub

Thank you for alll your help

Cool, Glad I could help. Mark your thread as solved in the thread options. Cheers Lewis.