Hi....I am trying to create a new worksheet with the rows of Data in the worksheet "Master" if the selected item is in column F. When I click on the Submit button, a worksheet is created but no data is populated. I get the error that I have bolded below....can anyone suggest what I missing....thanks.
VBA Code:
Private Sub Userform_Activate()
cboTypeStatus = ""
Dim xCell As Range, NoDupes As New Collection, Item
uRows = Sheets("Master").Cells(Sheets("Master").Rows.Count, "F").End(xlUp).Row
For Each xCell In Sheets("Master").Range("F2:F" & uRows)
On Error Resume Next
NoDupes.Add xCell.Value, CStr(xCell.Value)
Next xCell
For Each Item In NoDupes
Me.cboTypeStatus.AddItem Item
Next Item
End Sub
Private Sub cmdSubmit_Click()
Dim d As String
Dim X As String
Dim i As Long
Dim Y As Long
Range("F1").Value = cboTypeStatus
cboTypeStatus = Empty
frmTypeStatus.Hide
X = cboTypeStatus
[COLOR=rgb(0, 0, 0)][B]Sheets.Add.Name = Replace(CStr(X), ":", " ")[/B][/COLOR]
Sheets("Master").Activate
d = Range("F1").Value
i = 1
Do Until ActiveCell.Value = d
Cells(1, i).Select
i = i + 1
Loop
Rows(1).Copy Sheets(Replace(CStr(X), ":", " ")).Range("A" & Rows.Count).End(3)(2)
Sheets(Replace(CStr(X), ":", " ")).Range("A1").EntireRow.Delete Shift:=xlUp
Sheets("Master").Activate
For Y = 2 To 100000
If Cells(Y, ActiveCell.Column) = X Then
Cells(Y, ActiveCell.Column).EntireRow.Copy Sheets(Replace(CStr(X), ":", " ")).Range("A" & Rows.Count).End(3)(2)
End If
Next Y
Sheets(Replace(CStr(X), ":", " ")).Activate
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues
Do Until Cells(1, 1) <> ""
Cells(1, 1).Select
Cells(1, 1).EntireColumn.Delete Shift:=xlToRight
Loop
i = 1
For i = 1 To Worksheets.Count
Worksheets(i).Tab.ColorIndex = i + 10
Next
End Sub