I'm not sure why I'm getting the Application-Defined or Object-Defined Error on the below line:
AllRng.Resize(hard - 1, 1).Value = p.Value
Which is under the "SkipHard:" section towards the bottom of the code.
I went through a few other similar posts on here and tried applying some recommendations, including changing Sheets to Worksheets, but I'm not able to figure it out.
When I insert the this error code, the macro seems to be working fine, but not sure if this is bad practice:
On Error Resume Next
//Line here causes 1004 error.
If Err.Number > 0 Then
Debug.Print Err.Number & ":" & Err.Description
End If
*Additional Note: I've tried a number of different things now and also recreated the file I'm using multiple times. (It contains multiple macros). It seems like this problem only arises when I add this UDF into the workbook. Is that possible or am I off? Macro that looks up each value from one column and returns email address with ";" separator
Below is the entire code:
Option Explicit
Sub AssignBlocks()
Dim Records As Long, PasteTo As Long, People As Integer, LastP As Long
Dim balance As Integer, base As Integer, hard As Integer, p As Range
Dim AllRng As Range, BaseStart As Integer
'Copy/paste formats:
Dim i As Long
Dim var As Variant
Dim FirstTab As Worksheet
Dim SecondTab As Worksheet
Set FirstTab = Application.Worksheets("Employees List")
Set SecondTab = Application.Worksheets("Main")
Application.ScreenUpdating = False
'Assigning people to block:
People = Sheets("Block Assignment").Cells(Rows.Count, 16).End(xlUp).Row
If People <> 1 Then
Sheets("Block Assignment").Range("P2:P" & People).Clear
End If
'Pulling people from this column:
People = Sheets("Main").Cells(Rows.Count, 13).End(xlUp).Row
On Error Resume Next
Sheets("Block Assignment").Range("M2:M" & _
People).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0
Records = Sheets("Block Assignment").Cells(Rows.Count, 1).End(xlUp).Row - 1
People = Sheets("Main").Cells(Rows.Count, 13).End(xlUp).Row - 1
base = Application.WorksheetFunction.RoundDown(Records / People, 0)
balance = Records - (People * base)
hard = base + 1
Sheets("Main").Range("M2:M" & balance + 1).Name = "hardrng"
Sheets("Main").Range("M" & balance + 2 & ":M" & People + 1).Name = "easyrng"
If balance = 0 Then GoTo SkipHard
For Each p In Sheets("Main").Range("hardrng")
PasteTo = Sheets("Block Assignment").Cells(Rows.Count, 16).End(xlUp).Row + 1
Set AllRng = Sheets("Block Assignment").Range("P" & PasteTo)
AllRng.Resize(hard, 1).Value = p.Value
Next p
Skip hard:
For Each p In Sheets("Main").Range("easyrng")
PasteTo = Sheets("Block Assignment").Cells(Rows.Count, 16).End(xlUp).Row + 1
Set AllRng = Sheets("Block Assignment").Range("P" & PasteTo)
AllRng.Resize(hard - 1, 1).Value = p.Value
Next p
'Copy formats to column M's start:
For i = 2 To 1000
'How to only go to the last row with data?
var = Application.Match(SecondTab.Range("M" & i), FirstTab.Range("A:A"), 0)
If Not IsError(var) Then
FirstTab.Range("A" & var).Copy
SecondTab.Range("M" & i).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End If
Next i
'Copy formats to column T's end:
People = Sheets("Main").Cells(Rows.Count, 13).End(xlUp).Row
LastP = Sheets("Block Assignment").Cells(Rows.Count, 16).End(xlUp).Row
For Each p In Sheets("Main").Range("M2:M" & People)
ActiveWorkbook.Sheets("Block Assignment").Range("P:P").AutoFilter _
Field:=1, Criteria1:="" & p
p.Copy
On Error Resume Next
ActiveWorkbook.Sheets("Block Assignment").Range("P2:P" & _
LastP).SpecialCells(xlCellTypeVisible).PasteSpecial xlFormats
On Error GoTo 0
Application.CutCopyMode = False
Next p
ActiveWorkbook.Sheets("Block Assignment").AutoFilterMode = False
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Main").Range("A1").Select
End Sub
