VBA refernce range if the value of a cell is the first occurance

[mbp2987]

Hello,

I've been looking around the other forums an wasn't able to find anything helpful. I'm attempting to reference a range (A:C) if the value of column c on sh1 is not found in the sh2 column c (ie first occurance), however, my code doesn't return any values. I have provide my code for review below, any insight would be appreciated as I am relatively new to VBA.

Sub updt()
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.EnableEvents = False
 ActiveSheet.DisplayPageBreaks = False
 Dim sh1 As Worksheet, sh2 As Worksheet, lr, lsr As Long, c As Variant, r As Variant, lastform As Long, nextrow As Long, lastrow As Long, source As String, dest As String
 Set sh1 = Sheets("Sheet1")
 Set sh2 = Sheets("Insight")
 lr = sh1.Cells(Rows.count, 1).End(xlUp).Row
 lsr = sh2.Cells(Rows.count, 3).End(xlUp).Row
 Set Rng = sh1.Range("$C$15:$C" & lr)
 Set rg = sh2.Range("$A$3:C" & lsr)
     For Each c In Rng
        If WorksheetFunction.CountIf(sh2.Range("A:C"), c.Value) = 0 Then
             c.Value = sh1.Range("$A" & c.Row, "$C" & c.Row)
             sh2.Range("A" & sh2.Cells(Rows.count, 1).End(xlUp).Row)(2).Offset(-1, 0) = sh1.Range("A"&c.Row&":C"&c.Row
             )
             End If
        Next
        For Each r In rg
             lastform = sh2.Range("F" & Rows.count).End(xlUp).Row
             nextrow = lastform + 1
             lastrow = sh2.Range("C" & Rows.count).End(xlUp).Row
             source = "$F" & lastform & ":$AV" & lastform
             dest = "$F" & lastform & ":$AV" & lastrow
             If lastrow > lastform Then
                  Range(source).AutoFill Destination:=Range(dest), Type:=xlFillSeries
             End If
        Exit For
        Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    End Sub

 

[mbp2987]

Hi Again,

I've managed to fix the issue myself, however, I've run into another roadblock. Now, for some reason, the For Each statement isn't working correctly and only returns the last value in a range as opposed to each value in a range. Any insight are definitely appreciated, I've included the updated code below.

Sub updt()
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.EnableEvents = False
 ActiveSheet.DisplayPageBreaks = False
 Dim sh1 As Worksheet, sh2 As Worksheet, lr, lsr As Long, c As Variant, r As Variant, lastform As Long, nextrow As Long, lastrow As Long, source As String, dest As String
 Set sh1 = Sheets("Sheet1")
 Set sh2 = Sheets("Insight")
 lr = sh1.Cells(Rows.count, 3).End(xlUp).Row
 lsr = sh2.Cells(Rows.count, 3).End(xlUp).Row
 Set Rng = sh1.Range("$C$15:$C" & lr)
 Set rg = sh2.Range("$C$3:C" & lsr)
     For Each c In Rng
        If WorksheetFunction.CountIf(sh2.Range("C:C"), c.Value) = 0 Then
            sh2.Cells(sh2.Cells(Rows.count, 1).End(xlUp).Row - 2, 1)(3) = c.Offset(0, -2)
            sh2.Cells(sh2.Cells(Rows.count, 2).End(xlUp).Row - 2, 2)(3) = c.Offset(0, -1)
            sh2.Cells(sh2.Cells(Rows.count, 3).End(xlUp).Row - 2, 3)(3) = c.Value
            sh2.Cells(sh2.Cells(Rows.count, 4).End(xlUp).Row - 2, 4)(3) = c.Offset(0, 1)
            End If
        Next
     For Each r In rg
     lastform = sh2.Range("C" & Rows.count).End(xlUp).Row
     nextrow = lastform + 1
     lastrow = sh2.Range("F" & Rows.count).End(xlUp).Row
     source = "$F" & lastform & ":$AV" & lastform
     dest = "$F" & lastform & ":$AV" & lastrow
        If lastrow > lastform Then
            Range(source).AutoFill Destination:=Range(dest), Type:=xlFillSeries
            End If
        Exit For
        Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    End Sub