Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
So close and yet... (Pros Only)
....so far.
I have a spreadsheet 5000 deep and 90 across. I need the code below to launch an input box so that when I enter a value into this box I want any row on which the value occours to be cut and pasted into a new sheet, all the while cells/rows on the original sheet are moved upwards. I'm almost there but I'm left scratching my head. Any help would be appreciated... Public Sub transfer() Worksheets("Sheet1").Activate Dim lastrow As Long Dim lastcol As Long Dim sString As String 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 Dim ir As Long, ic As Long, rd As Long For ir = lastrow To 1 Step -1 For ic = lastcol To 1 Step -1 Cells(ir, ic).Activate If UCase(Cells(ir, ic).Value) = UCase(sString) Then Rows(ir).Copy Destination:=Sheets (yournewsheet).Range("A1").End(xlDown).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 Cheers Gordon. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
So close and yet... (Pros Only)
Public Sub transfer()
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 -- HTH Bob Phillips ... looking out across Poole Harbour to the Purbecks (remove nothere from the email address if mailing direct) "Gordon C" wrote in message ... ...so far. I have a spreadsheet 5000 deep and 90 across. I need the code below to launch an input box so that when I enter a value into this box I want any row on which the value occours to be cut and pasted into a new sheet, all the while cells/rows on the original sheet are moved upwards. I'm almost there but I'm left scratching my head. Any help would be appreciated... Public Sub transfer() Worksheets("Sheet1").Activate Dim lastrow As Long Dim lastcol As Long Dim sString As String 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 Dim ir As Long, ic As Long, rd As Long For ir = lastrow To 1 Step -1 For ic = lastcol To 1 Step -1 Cells(ir, ic).Activate If UCase(Cells(ir, ic).Value) = UCase(sString) Then Rows(ir).Copy Destination:=Sheets (yournewsheet).Range("A1").End(xlDown).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 Cheers Gordon. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
So close and yet... (Pros Only)
What's changed in the last 11 days?
-- Regards, Tom Ogilvy "Gordon C" wrote in message ... ...so far. I have a spreadsheet 5000 deep and 90 across. I need the code below to launch an input box so that when I enter a value into this box I want any row on which the value occours to be cut and pasted into a new sheet, all the while cells/rows on the original sheet are moved upwards. I'm almost there but I'm left scratching my head. Any help would be appreciated... Public Sub transfer() Worksheets("Sheet1").Activate Dim lastrow As Long Dim lastcol As Long Dim sString As String 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 Dim ir As Long, ic As Long, rd As Long For ir = lastrow To 1 Step -1 For ic = lastcol To 1 Step -1 Cells(ir, ic).Activate If UCase(Cells(ir, ic).Value) = UCase(sString) Then Rows(ir).Copy Destination:=Sheets (yournewsheet).Range("A1").End(xlDown).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 Cheers Gordon. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Easy one for you pros! | Excel Worksheet Functions | |||
Easy one for the Pros! | Excel Worksheet Functions | |||
Pros and Cons of embedding Excel Workbook object in PPT Presentati | Excel Discussion (Misc queries) | |||
Help Excel Data manipulation Pros: Something like a Vlookup with a Sum Function | Excel Worksheet Functions | |||
Excel as a development Platform? pros and cons? | Excel Programming |