0

I am trying to stack data from several sheets in one mastershhet (the sheet where I am running this Macros). So its essentially the same code replicated a few times. I also want to highlight duplicates in the first column and thus last bit is about that. Can't figure out why do I keep getting 'Object Required' Error. Any help will be greatly appreciated.

Sub Stackdata()
Dim emptyrow As Long, lastrow As Long, lastcolumn As Long



Workbooks.Open ”Declined.csv”
Worksheets(1).Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close

Worksheets(1).Select
emptyrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(emptyrow, 1).Select
ActiveSheet.Paste


Workbooks.Open ”Offersbutwithdrawn.csv”
Worksheets(1).Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close

Worksheets(1).Select
emptyrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(emptyrow, 1).Select
ActiveSheet.Paste



Dim iWarnColor As Integer
Dim rng As Range
Dim rngCell As Variant


Set rng = Range("A1:A200") ' area to check '
iWarnColor = xlThemeColorAccent2
For Each rngCell In rng.Cells
    vVal = rngCell.Text
    If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
        rngCell.Interior.Pattern = xlNone
    Else
        rngCell.Interior.ColorIndex = iWarnColor
End If
Next rngCell


End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Ronnie
  • 1
  • 3
    Please read this https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba. Also, refer to a wb & ws for each Range object – Tim Stack Apr 30 '19 at 06:54
  • 1
    Please tell us the line you are getting the error on – Tim Stack Apr 30 '19 at 06:57
  • 2
    Note that the fancy quotes you used `” ”` are not allowed in VBA you need to replace them with the normal ones `" "`. • Also `Workbooks.Open` needs the full path of the file. – Pᴇʜ Apr 30 '19 at 06:58
  • 1
    If you are using the same code repeatedly to do the same things to different files like this, then consider either using a Loop (with an Array of inputs) or a Subroutine that can be called with the File Name. – Chronocidal Apr 30 '19 at 07:56
  • Hi Tim, the error is in 'Workbooks.Open ”Declined.csv”' line. – Ronnie Apr 30 '19 at 23:46
  • @Ronnie You should read my comment again. It tells you why you get an error there. – Pᴇʜ May 02 '19 at 06:58

1 Answers1

0

I did shorten your code and deleted anything related to .Select to avoid errors. Thought I can't see where the error comes from, Let me know if this code works for you. If it doesn't come back after you debug the error line and tell us:

Option Explicit
Sub Stackdata()

    Dim emptyrow As Long, lastrow As Long, lastcolumn As Long, i As Long
    Dim wb As Workbook, wbSource As Workbook, arrWorkbooks, ws As Worksheet, wsSource As Worksheet

    arrWorkbooks = Array("Declined.csv", "Offersbutwithdrawn.csv") 'here you can add as many workbooks as you need

    'reference and declare workbooks and worksheets to avoid .Select
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)

    'A loop through all your workbooks on the variable arrWorkbooks
    For i = 0 To UBound(workbooks)
        Set wbSource = workbooks.Open(arrWorkbooks(i), ReadOnly:=True) 'thought you need the full path before the file name
        Set wsSource = wbSource.Sheets(1)
        emptyrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
        With wsSource
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
            .Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy ws.Cells(emptyrow, 1)
        End With
    Next i


    Dim iWarnColor As Integer
    Dim rng As Range
    Dim rngCell As Variant

    With ws
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Range("A1:A" & lastrow) ' area to check ' now it gets to the last row always
        iWarnColor = xlThemeColorAccent2
        For Each rngCell In rng.Cells
            vVal = rngCell.Text
            If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
                rngCell.Interior.Pattern = xlNone
            Else
                rngCell.Interior.ColorIndex = iWarnColor
            End If
        Next rngCell
    End With

End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Damian
  • 5,152
  • 1
  • 10
  • 21
  • This code returns a runtime error 1004: 'Declined.csv' can't be found. Its a bit odd that I am getting this error because that workbook is in the same folder and under the name exactly as defined in this code. The error is in 'Set wbSource = Workbooks.Open(arrWorkbooks(i), ReadOnly:=True)' line. – Ronnie Apr 30 '19 at 23:42
  • Like the comment says... you need to reference the path... If it's in the same path a simple `wb.Path & "\" & arrWorkbooks(i)` would do it. – Damian May 01 '19 at 10:13