TrinColll
06-11-2013, 01:18 PM
Hi I've gotten stuck trying to copy a vba variant to an excel range which is a singular row with multiple columns. Ive provided all of my code as I suspect I have declared my variants sizing in a way that is preventing my code from being run. At the moment it gets an application defined or object defined run time error. On the line
Sheets("IT DASH").Range(Cells(1, 2), Cells(1, UBound(IT))) = IT
Any Ideas would be great thanks!
Sub PopulateDash()
Dim IT As Variant
ReDim IT(1 to 1) As Variant
Dim RD As Variant
ReDim RD(1 To 1) As Variant
Dim QA As Variant
ReDim QA(1 To 1) As Variant
Dim QC As Variant
ReDim QC(1 To 1) As Variant
Dim Test As Variant
ReDim Test(1 To 1) As Variant
Dim Dev As Variant
ReDim Dev(1 To 1) As Variant
Dim PM As Variant
ReDim PM(1 To 1) As Variant
Dim Admin As Variant
ReDim Admin(1 To 1) As Variant
Dim HD As Variant
ReDim HD(1 To 1) As Variant
For Each chk In Sheets("SOP REQUIREMENTS").CheckBoxes
If chk.Value = Checked Then
Set cell = chk.TopLeftCell
Select Case cell.row
Case 2:
IT(UBound(IT)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve IT(1 To UBound(IT) + 1)
Case 3:
RD(UBound(RD)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve RD(1 To UBound(RD) + 1)
Case 4:
QA(UBound(QA)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve QA(1 To UBound(QA) + 1)
Case 5:
QC(UBound(QC)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve QC(1 To UBound(QC) + 1)
Case 6:
Test(UBound(Test)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve Test(1 To UBound(Test) + 1)
Case 7:
Dev(UBound(Dev)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve Dev(1 To UBound(Dev) + 1)
Case 8:
PM(UBound(PM)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve PM(1 To UBound(PM) + 1)
Case 9:
Admin(UBound(Admin)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve Admin(1 To UBound(Admin) + 1)
Case 10:
HD(UBound(HD)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve HD(1 To UBound(HD) + 1)
End Select
Else
End If
Next
Sheets("IT DASH").Cells.ClearContents
Sheets("RD DASH").Cells.ClearContents
Sheets("QA DASH").Cells.ClearContents
Sheets("QC DASH").Cells.ClearContents
Sheets("Test DASH").Cells.ClearContents
Sheets("Dev DASH").Cells.ClearContents
Sheets("PM DASH").Cells.ClearContents
Sheets("Admin DASH").Cells.ClearContents
Sheets("HD DASH").Cells.ClearContents
Sheets("IT DASH").Range(Cells(1, 2), Cells(1, UBound(IT))) = IT
Sheets("RD DASH").Range(Cells(1, 2), Cells(1, UBound(RD))) = RD
Sheets("QA DASH").Range(Cells(1, 2), Cells(1, UBound(QA))) = QA
Sheets("QC DASH").Range(Cells(1, 2), Cells(1, UBound(QC))) = QC
Sheets("Test DASH").Range(Cells(1, 2), Cells(1, UBound(Test))) = Test
Sheets("Dev DASH").Range(Cells(1, 2), Cells(1, UBound(Dev))) = Dev
Sheets("PM DASH").Range(Cells(1, 2), Cells(1, UBound(PM))) = PM
Sheets("Admin DASH").Range(Cells(1, 2), Cells(1, UBound(Admin))) = Admin
Sheets("HD DASH").Range(Cells(1, 2), Cells(1, UBound(HD))) = HD
End Sub
Sheets("IT DASH").Range(Cells(1, 2), Cells(1, UBound(IT))) = IT
Any Ideas would be great thanks!
Sub PopulateDash()
Dim IT As Variant
ReDim IT(1 to 1) As Variant
Dim RD As Variant
ReDim RD(1 To 1) As Variant
Dim QA As Variant
ReDim QA(1 To 1) As Variant
Dim QC As Variant
ReDim QC(1 To 1) As Variant
Dim Test As Variant
ReDim Test(1 To 1) As Variant
Dim Dev As Variant
ReDim Dev(1 To 1) As Variant
Dim PM As Variant
ReDim PM(1 To 1) As Variant
Dim Admin As Variant
ReDim Admin(1 To 1) As Variant
Dim HD As Variant
ReDim HD(1 To 1) As Variant
For Each chk In Sheets("SOP REQUIREMENTS").CheckBoxes
If chk.Value = Checked Then
Set cell = chk.TopLeftCell
Select Case cell.row
Case 2:
IT(UBound(IT)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve IT(1 To UBound(IT) + 1)
Case 3:
RD(UBound(RD)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve RD(1 To UBound(RD) + 1)
Case 4:
QA(UBound(QA)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve QA(1 To UBound(QA) + 1)
Case 5:
QC(UBound(QC)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve QC(1 To UBound(QC) + 1)
Case 6:
Test(UBound(Test)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve Test(1 To UBound(Test) + 1)
Case 7:
Dev(UBound(Dev)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve Dev(1 To UBound(Dev) + 1)
Case 8:
PM(UBound(PM)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve PM(1 To UBound(PM) + 1)
Case 9:
Admin(UBound(Admin)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve Admin(1 To UBound(Admin) + 1)
Case 10:
HD(UBound(HD)) = Sheets("SOP REQUIREMENTS").Cells(1, cell.Column).Value
ReDim Preserve HD(1 To UBound(HD) + 1)
End Select
Else
End If
Next
Sheets("IT DASH").Cells.ClearContents
Sheets("RD DASH").Cells.ClearContents
Sheets("QA DASH").Cells.ClearContents
Sheets("QC DASH").Cells.ClearContents
Sheets("Test DASH").Cells.ClearContents
Sheets("Dev DASH").Cells.ClearContents
Sheets("PM DASH").Cells.ClearContents
Sheets("Admin DASH").Cells.ClearContents
Sheets("HD DASH").Cells.ClearContents
Sheets("IT DASH").Range(Cells(1, 2), Cells(1, UBound(IT))) = IT
Sheets("RD DASH").Range(Cells(1, 2), Cells(1, UBound(RD))) = RD
Sheets("QA DASH").Range(Cells(1, 2), Cells(1, UBound(QA))) = QA
Sheets("QC DASH").Range(Cells(1, 2), Cells(1, UBound(QC))) = QC
Sheets("Test DASH").Range(Cells(1, 2), Cells(1, UBound(Test))) = Test
Sheets("Dev DASH").Range(Cells(1, 2), Cells(1, UBound(Dev))) = Dev
Sheets("PM DASH").Range(Cells(1, 2), Cells(1, UBound(PM))) = PM
Sheets("Admin DASH").Range(Cells(1, 2), Cells(1, UBound(Admin))) = Admin
Sheets("HD DASH").Range(Cells(1, 2), Cells(1, UBound(HD))) = HD
End Sub