dwiravi
10-24-2016, 11:29 PM
HI,
Iam receiving run time error '13' type mismatch error. Have marked the RED where its failing. Code as below. Please suggest.
Sub CreateNewProjectList()
'Call the function with worksheets as the parameters
CompareWorksheets Worksheets("CMSRSC"), Worksheets("PMG")
End Sub
Sub CompareWorksheets(wsCMSRSC As Worksheet, wsPrjGrp As Worksheet)
Dim wsPrjGrpRow As Long, wsPrjGrpCol As Integer, wsCMSRSCRow As Long, wsCMSRSCCol As Integer
Dim maxRow As Long, maxcol As Integer
Dim irow1 As Long, icol2 As Long, wsNewPrjRow As Integer, iColCount As Integer
Dim bFound As Boolean
Dim wsCMSRSCValues(1 To 100) As String
wsNewPrjRow = 2
'Code to create new Worksheet
Dim wsSheet As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
Set wsSheet = Sheets("NewPA")
On Error GoTo 0
If Not wsSheet Is Nothing Then wsSheet.Delete
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "NewPA"
Application.DisplayAlerts = True
CreateColumn Worksheets("NewPA"), Worksheets("CMSRSC")
'Count Row and Columns in Project Grouping worksheet
With wsPrjGrp.UsedRange
wsPrjGrpRow = .Rows.Count
wsPrjGrpCol = .Columns.Count
End With
'Count Row and Columns in KPI Report Worksheet
With wsCMSRSC.UsedRange
wsCMSRSCRow = .Rows.Count
wsCMSRSCCol = .Columns.Count
End With
maxRow = wsCMSRSCRow
maxcol = wsCMSRSCCol
bFound = True
For irow1 = 2 To maxRow
For irow2 = 2 To wsPrjGrpRow
If wsCMSRSC.Cells(irow1, 1) <> wsPrjGrp.Cells(irow2, 1) Then
bFound = False
Else
bFound = True
Exit For
End If
Next irow2
If bFound = False Then
For iColCount = 1 To wsCMSRSCCol
wsCMSRSCValues(iColCount) = wsCMSRSC.Cells(irow1, iColCount)
Cells(wsNewPrjRow, iColCount).Borders.LineStyle = xlContinuous
Next iColCount
'Insert Data in New PA Sheet
Sheets(Sheets.Count).Cells(wsNewPrjRow, 1) = wsCMSRSCValues(1)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 2) = wsCMSRSCValues(2)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 3) = wsCMSRSCValues(3)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 4) = wsCMSRSCValues(4)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 5) = wsCMSRSCValues(5)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 6) = wsCMSRSCValues(6)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 7) = wsCMSRSCValues(7)
'Sheets(Sheets.Count).Cells(wsNewPrjRow, 8) = wsCMSRSCValues(8)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 9) = wsCMSRSCValues(9)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 10) = wsCMSRSCValues(10)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 11) = wsCMSRSCValues(11)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 12) = wsCMSRSCValues(12)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 13) = wsCMSRSCValues(13)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 14) = wsCMSRSCValues(14)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 15) = wsCMSRSCValues(15)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 16) = wsCMSRSCValues(16)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 17) = wsCMSRSCValues(17)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 18) = wsCMSRSCValues(18)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 19) = wsCMSRSCValues(19)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 20) = wsCMSRSCValues(20)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 21) = wsCMSRSCValues(21)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 24) = wsCMSRSCValues(24)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 26) = wsCMSRSCValues(26)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 60) = wsCMSRSCValues(60)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 48) = wsCMSRSCValues(48)
wsNewPrjRow = wsNewPrjRow + 1
End If
Next irow1
Sheets(Sheets.Count).Select
MsgBox "Activity Completed"
End Sub
Sub CreateColumn(wsNewPA As Worksheet, wsPMG As Worksheet)
Dim wsPMGCol1 As Integer, iColCount As Integer
With wsPMG.UsedRange
wsPMGCol1 = .Columns.Count
End With
For iColCount = 1 To wsPMGCol1
wsNewPA.Cells(1, iColCount) = wsPMG.Cells(1, iColCount)
Cells(1, iColCount).HorizontalAlignment = xlCenter
Cells(1, iColCount).Interior.Color = RGB(255, 0, 0)
Cells(1, iColCount).Font.Color = vbWhite
Cells(1, iColCount).Font.Bold = True
Cells(1, iColCount).Borders.LineStyle = xlContinuous
Next iColCount
End Sub
Iam receiving run time error '13' type mismatch error. Have marked the RED where its failing. Code as below. Please suggest.
Sub CreateNewProjectList()
'Call the function with worksheets as the parameters
CompareWorksheets Worksheets("CMSRSC"), Worksheets("PMG")
End Sub
Sub CompareWorksheets(wsCMSRSC As Worksheet, wsPrjGrp As Worksheet)
Dim wsPrjGrpRow As Long, wsPrjGrpCol As Integer, wsCMSRSCRow As Long, wsCMSRSCCol As Integer
Dim maxRow As Long, maxcol As Integer
Dim irow1 As Long, icol2 As Long, wsNewPrjRow As Integer, iColCount As Integer
Dim bFound As Boolean
Dim wsCMSRSCValues(1 To 100) As String
wsNewPrjRow = 2
'Code to create new Worksheet
Dim wsSheet As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
Set wsSheet = Sheets("NewPA")
On Error GoTo 0
If Not wsSheet Is Nothing Then wsSheet.Delete
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "NewPA"
Application.DisplayAlerts = True
CreateColumn Worksheets("NewPA"), Worksheets("CMSRSC")
'Count Row and Columns in Project Grouping worksheet
With wsPrjGrp.UsedRange
wsPrjGrpRow = .Rows.Count
wsPrjGrpCol = .Columns.Count
End With
'Count Row and Columns in KPI Report Worksheet
With wsCMSRSC.UsedRange
wsCMSRSCRow = .Rows.Count
wsCMSRSCCol = .Columns.Count
End With
maxRow = wsCMSRSCRow
maxcol = wsCMSRSCCol
bFound = True
For irow1 = 2 To maxRow
For irow2 = 2 To wsPrjGrpRow
If wsCMSRSC.Cells(irow1, 1) <> wsPrjGrp.Cells(irow2, 1) Then
bFound = False
Else
bFound = True
Exit For
End If
Next irow2
If bFound = False Then
For iColCount = 1 To wsCMSRSCCol
wsCMSRSCValues(iColCount) = wsCMSRSC.Cells(irow1, iColCount)
Cells(wsNewPrjRow, iColCount).Borders.LineStyle = xlContinuous
Next iColCount
'Insert Data in New PA Sheet
Sheets(Sheets.Count).Cells(wsNewPrjRow, 1) = wsCMSRSCValues(1)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 2) = wsCMSRSCValues(2)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 3) = wsCMSRSCValues(3)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 4) = wsCMSRSCValues(4)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 5) = wsCMSRSCValues(5)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 6) = wsCMSRSCValues(6)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 7) = wsCMSRSCValues(7)
'Sheets(Sheets.Count).Cells(wsNewPrjRow, 8) = wsCMSRSCValues(8)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 9) = wsCMSRSCValues(9)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 10) = wsCMSRSCValues(10)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 11) = wsCMSRSCValues(11)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 12) = wsCMSRSCValues(12)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 13) = wsCMSRSCValues(13)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 14) = wsCMSRSCValues(14)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 15) = wsCMSRSCValues(15)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 16) = wsCMSRSCValues(16)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 17) = wsCMSRSCValues(17)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 18) = wsCMSRSCValues(18)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 19) = wsCMSRSCValues(19)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 20) = wsCMSRSCValues(20)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 21) = wsCMSRSCValues(21)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 24) = wsCMSRSCValues(24)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 26) = wsCMSRSCValues(26)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 60) = wsCMSRSCValues(60)
Sheets(Sheets.Count).Cells(wsNewPrjRow, 48) = wsCMSRSCValues(48)
wsNewPrjRow = wsNewPrjRow + 1
End If
Next irow1
Sheets(Sheets.Count).Select
MsgBox "Activity Completed"
End Sub
Sub CreateColumn(wsNewPA As Worksheet, wsPMG As Worksheet)
Dim wsPMGCol1 As Integer, iColCount As Integer
With wsPMG.UsedRange
wsPMGCol1 = .Columns.Count
End With
For iColCount = 1 To wsPMGCol1
wsNewPA.Cells(1, iColCount) = wsPMG.Cells(1, iColCount)
Cells(1, iColCount).HorizontalAlignment = xlCenter
Cells(1, iColCount).Interior.Color = RGB(255, 0, 0)
Cells(1, iColCount).Font.Color = vbWhite
Cells(1, iColCount).Font.Bold = True
Cells(1, iColCount).Borders.LineStyle = xlContinuous
Next iColCount
End Sub