Prev: Columns("C:C").Value = Columns("D:D").Value not working after addi
Next: DTPicker controls missing from userform
From: Duane on 20 May 2010 14:05

Joel, Your code worked great last month , This month I get an "error 13
TypeMismatch" when I try to run my macro. here is my code the error
occurs at "If InStr(UCase(.Range("b" & RowCount)), "Total") > 0 Then"



'*********NOTE ADD "TOTAL" TO COLUMN "A" BEFORE EXPANDING AND RUNNING
THIS MACRO**********************
'ADDITIONAL NOTES CECK COLUMN FOR CONTRACTOR AND COUNT , ELIMINATE
ILLEGAL CHARACTERS IN CONTRACTOR NAMES BEFORE RUNNING

'change directory
Folder = "h:\Contractor Expired\Contractor Expired Apr2010\"
'Folder = "\\dpd-sharepoint\electrical\Contractor Expired
Spreadsheets\April2010"

'assume there is a header row which gets copied to each new sheet

Set Sourcesht = ThisWorkbook.Sheets("Expired")

With Sourcesht
LastRow = .Range("h" & Rows.Count).End(xlUp).Row
'ignore the Grand Total line if one exists
If InStr(UCase(.Range("h" & LastRow)), "GRAND") > 0 Then
LastRow = LastRow - 1
End If
Application.ScreenUpdating = False

StartRow = 2
RowCount = StartRow
For RowCount = StartRow To LastRow
' Application.IsError (CellValue)
If InStr(UCase(.Range("b" & RowCount)), "Total") > 0 Then
client = .Range("H" & StartRow)
'create new workbook
Set newbook = Workbooks.Add(template:=xlWBATWorksheet)
Set newsht = newbook.Sheets(1)
'change sheet name to clients name
newsht.Name = client
'copy header row
.Rows(1).Copy Destination:=newsht.Rows(1)
'copy data
.Rows(StartRow & ":" & RowCount).Copy _
Destination:=newsht.Rows(2)
StartRow = RowCount + 1
'newbook.Active
newbook.SaveAs Filename:=Folder & client
FormatContractorList 'macro that hides some columns in new WB
newbook.Close savechanges:=True
End If
Next RowCount

End With

End Sub


Thank You again for your help
Duane







j
o
e
l
;
6
9
3
0
0
0

W
r
o
t
e
:


>
The code below I didn't test but is very similar to the older macro.
You should be able to get it working like the last macro
>
> Sub SplitSubtotal()
>
> Folder = "h:\clients\"
>
> 'assume there is a header row which gets copied to each new sheet
>
> Set Sourcesht = ThisWorkbook.Sheets("Sheet1")
>
> With Sourcesht
> LastRow = .Range("A" & Rows.Count).End(xlUp).Row
> 'ignore the Grand Total line if one exists
> If InStr(UCase(.Range("A" & LastRow)), "GRAND") > 0 Then
> LastRow = LastRow - 1
> End If
>
> StartRow = 2
> RowCount = StartRow
> For RowCount = StartRow To LastRow
> If InStr(UCase(.Range("A" & RowCount)), "TOTAL") > 0 Then
> client = .Range("A" & StartRow)
> 'create new workbook
> Set Newbook = Workbooks.Add(template:=xlWBATWorksheet)
> Set newsht = Newbook.Sheets(1)
> 'change sheet name to clients name
> newsht.Name = client
> 'copy header row
> .Rows(1).Copy Destination:=newsht.Rows(1)
> 'copy data
> .Rows(StartRow & ":" & RowCount).Copy _
> Destination:=newsht.Rows(2)
> StartRow = RowCount + 1
> Newbook.SaveAs Filename:=Folder & client
> Newbook.Close savechanges:=True
> End If
> Next RowCount
>
> End With
>
> End Sub


--
Duane
------------------------------------------------------------------------
Duane's Profile: http://www.thecodecage.com/forumz/member.php?u=1891
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=193510

http://www.thecodecage.com/forumz

From: joel on 20 May 2010 16:26

The only reason I can see for the instruction to give an error is if
you had a formula in column b that produced an Error. Se if this change
help you find the problem

'from
For RowCount = StartRow To LastRow
' Application.IsError (CellValue)
If InStr(UCase(.Range("b" & RowCount)), "Total") > 0 Then

'To
For RowCount = StartRow To LastRow
If WorksheetFunction.IsError("Expired!B" & RowCount)) Then
MsgBox ("Error in Cell : B" & RowCount & vbCrLf & _
"Exiting Macro")
Exit Sub
End If
' Application.IsError (CellValue)
If InStr(UCase(.Range("b" & RowCount)), "Total") > 0 Then


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=193510

http://www.thecodecage.com/forumz

 | 
Pages: 1
Prev: Columns("C:C").Value = Columns("D:D").Value not working after addi
Next: DTPicker controls missing from userform