Bug-Fixing needed: Auto fill in new sheet using for loop

Question

I've tried for hours and it keeps showing error message.

RUN TIME ERROR 1004 - Select method of range class failed

Could some one help to point the busg out?

Thank you.

Adding Column D to raw data as index for lookup

Screencap 1 - Adding Column D to raw data as index for lookup

The result I'd like to have

Screencap 2 - The result I'd like to have

Sub Macro()
    ActiveSheet.Name = "Data"
    Sheets("Data").Select
    Dim LastRowData As Long
    LastRowData = Range("A" & Rows.Count).End(xlUp).Row
    Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1") = "Lookup"
    Range("D2") = "=RC[-3]&RC[-1]"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & Rows.Count)
    Columns("D:D").Copy
    Columns("D:D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Promo"
    Range("A1") = "Date"
    Range("B1") = "SKUs"
    Range("C1") = "Customer"
    Range("D1") = "Regular $"
    Range("E1") = "Promo $"

    Dim iData As Variant
    Dim LastEntry As Variant
    Dim PreviousLast As Variant

    DayofMonth = Sheets("Data").Cells(1, Sheets("Data").Columns.Count).End(xlToLeft).Column - 5
    LastEntry = DayofMonth * (LastRowData - 1)

    For iData = 1 To LastEntry
            Sheets("Data").Select
            Range("F1:AJ1").Select
            Selection.Copy
            PreviousLast = Cells(Rows.Count, "A").End(xlUp).Row

            Sheets("Promo").Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            Sheets("Promo").Range("B" & PreviousLast + 1 & ":B" & (DayofMonth + PreviousLast + 1)) = Sheets("Data").Range("A" & iData).Value
    Next iData

    Sheets("Promo").Select
    Range("E2") = _
        "=VLOOKUP(RC[-3]&RC[-2], Data!$D:$AJ, MATCH(Promo!RC1, Data!R1, 0)-3, 0)"
    Range("E2").FillDown
        Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Files: Excel attachment link

And read this https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — SJR, Jan 23 '20 at 17:48
Reading that link will rectify the problem because you cannot select a cell on a sheet unless it is already active. But you don't need any of that anyway. — SJR, Jan 23 '20 at 17:55

score 1 · Answer 1 · answered Jan 23 '20 at 19:34

Huge thanks to @SJR. You did help me a lot!

Sub Macro()
    ActiveSheet.Name = "Data"
    Dim LastRowData As Long
    LastRowData = Range("A" & Rows.Count).End(xlUp).Row

    Cells.ClearFormats
    Range("A1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With
    Rows("1:1").Font.Bold = True
    Range("D2:I" & LastRowData).NumberFormat = "$#,##0.00"
    Range("E1:AJ1").NumberFormat = "[$-en-US]d-mmm;@"

    With Sheets("Data")
        .Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("D1").Value = "Lookup"
        .Range("D2") = "=RC[-3]&RC[-1]"
        .Range("D2").AutoFill Destination:=.Range("D2:D" & LastRowData)
        .Range("D2:D" & LastRowData).Copy
        .Range("D2:D" & LastRowData).PasteSpecial xlPasteValues
    End With

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Promo"
    With Sheets("Promo")
        .Range("A1").Value = "Date"
        .Range("B1").Value = "Style"
        .Range("C1").Value = "Customer"
        .Range("D1").Value = "Regular $"
        .Range("E1").Value = "Promo $"
        .Range("1:1").Font.Bold = True
    End With

    Dim iData As Variant
    Dim LastEntry As Variant
    Dim PreviousLast As Variant

    DayofMonth = Sheets("Data").Cells(1, Sheets("Data").Columns.Count).End(xlToLeft).Column - 5
    LastEntry = DayofMonth * LastRowData - 5 + 1

    For iData = 1 To LastRowData - 1
        PreviousLast = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheets("Data").Range("F1:AJ1").Copy
        Sheets("Promo").Range("A" & PreviousLast).PasteSpecial Transpose:=True
        Sheets("Data").Range("A" & iData + 1).Copy
        Sheets("Promo").Range("B" & PreviousLast & ":B" & (DayofMonth + PreviousLast - 1)).PasteSpecial
        Sheets("Data").Range("C" & iData + 1).Copy
        Sheets("Promo").Range("C" & PreviousLast & ":C" & (DayofMonth + PreviousLast - 1)).PasteSpecial
        Sheets("Data").Range("E" & iData + 1).Copy
        Sheets("Promo").Range("D" & PreviousLast & ":D" & (DayofMonth + PreviousLast - 1)).PasteSpecial
    Next iData

    With Sheets("Promo")
        .Range("E2").NumberFormat = "$#,##0.00"
        .Range("E2").FormulaR1C1 = _
            "=VLOOKUP(RC2&RC3, Data!C4:C36, MATCH(Promo!RC1,Data!R1, 0) - 3,0)"
        .Range("E2").AutoFill Destination:=.Range("E2:E" & LastEntry)
        .Range("E2:E" & LastEntry).Copy
        .Range("E2:E" & LastEntry).PasteSpecial Paste:=xlPasteValues
    End With

    Range("A1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With

    Rows("1:" & LastEntry).Select
    Selection.AutoFilter Field:=5, Criteria1:="=$0.00"
    Selection.Offset(1, 0).EntireRow.Delete
    ActiveSheet.ShowAllData
End Sub

Bug-Fixing needed: Auto fill in new sheet using for loop

1 Answers1