G
Gordon
Help!!
I have a rather large spreadsheet with over 10,000 cells containing various
data. The code below helped me extract any information from the main
spreadsheet (sheet1) and drop it into a new spreadsheet (sheet2). It has
worked fine in my office 2000 but when I transferred it to XP I got this
error message saying type mismatch error 13. So I transferred it back to 2000
and got the same message which I though was odd. The code steps past the
input ox then the error appears.
Can anyone help me here.
Public Sub transfer()
'created by GC. powerexcel.co.uk 18/08/2004
Dim lastrow As Long
Dim lastcol As Long
Dim ir As Long, ic As Long, rd As Long
Dim sString As String
Dim yournewsheet As String
yournewsheet = "Sheet2"
Worksheets("Sheet1").Activate
sString = InputBox("ENTER YOUR VALUE: ANY ROW ON WHICH THIS VALUE IS
FOUND WILL BE COPIED TO A NEW SHEET")
If sString = "" Then
MsgBox "No search criteria requested.", vbOKOnly + vbInformation,
"Cancel is pressed."
Exit Sub
End If
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Copy Destination:=Sheets(yournewsheet).Range("A" &
Rows.Count).End(xlUp).Offset(1, 0)
Rows(ir).Delete Shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub
Thanks
Gordon.
I have a rather large spreadsheet with over 10,000 cells containing various
data. The code below helped me extract any information from the main
spreadsheet (sheet1) and drop it into a new spreadsheet (sheet2). It has
worked fine in my office 2000 but when I transferred it to XP I got this
error message saying type mismatch error 13. So I transferred it back to 2000
and got the same message which I though was odd. The code steps past the
input ox then the error appears.
Can anyone help me here.
Public Sub transfer()
'created by GC. powerexcel.co.uk 18/08/2004
Dim lastrow As Long
Dim lastcol As Long
Dim ir As Long, ic As Long, rd As Long
Dim sString As String
Dim yournewsheet As String
yournewsheet = "Sheet2"
Worksheets("Sheet1").Activate
sString = InputBox("ENTER YOUR VALUE: ANY ROW ON WHICH THIS VALUE IS
FOUND WILL BE COPIED TO A NEW SHEET")
If sString = "" Then
MsgBox "No search criteria requested.", vbOKOnly + vbInformation,
"Cancel is pressed."
Exit Sub
End If
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Copy Destination:=Sheets(yournewsheet).Range("A" &
Rows.Count).End(xlUp).Offset(1, 0)
Rows(ir).Delete Shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub
Thanks
Gordon.