Copy columns, Search Criteria, Delete Cells 4

[mattloflin]

Hey guys

Sorry for all the questions it's just the fact all you guys know the answers and i'm learning alot from then answers.

my question today is how would I do the following:

Copy Column A and M from one workbook to a New workbook placing column A in Column B and Column M in Column C

Column A of the NEW workbook needs to have "Probe" in the cells but only to the extent of the Last row of the Columns just pasted.

Second once they are pasted I need to search Column M (now column C) and if the first two letters don't equal J1 J2 or J3 then I need it to delete the ROW.

Any ideas? I'm not at work right now or I would be using a macro record to figure it all out but I figure someone has a two line code that does it where as I'd have about 75.

I'm getting more proficient but learning the right way first is much easier than relearning something you thought to be true that wasn't.

haha,

Thanks in advance,
Matt

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[SkipVought]

Matt,

This is a job for MS Query. faq68-5829

Select 
  'Probe' as WhateverHeadingYouWant
, [Column A Heading]
, [Column M Heading]
From [Sheet1$]
Where Left([Column A Heading],2) Not In ('J1','J2','J3')

Skip,

_{I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent!}

 

[xlbo]

Plus I would try recording your actions 1st to get the basic code. Stitch it together and post here if you have any issues with it or need help making it more efficient or smarter....

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[mattloflin]

Ok I have recorded and edited and used some of my other code to get this:

Dim NewName As String
Dim x As String
    x = Application.ActiveWorkbook.FullName
    OldX = Application.ActiveWorkbook.Name

    If Right((x), 8) = " GTS.xls" Then
        NewName = Left((x), Len(x) - 8) & " GTS" & ".xls"
    Else
        NewName = Left((x), Len(x) - 4) & " GTS" & ".xls"
    End If
    
    Workbooks.Add
    ActiveWorkbook.SaveAs NewName
    NewX = Application.ActiveWorkbook.Name
    Windows(OldX).Activate
    Columns("A:A").Copy
    Windows(NewX).Activate
    Columns("C:C").Select
    ActiveSheet.Paste
    Windows(OldX).Activate
    Columns("M:M").Copy
    Windows(NewX).Activate
    Columns("B:B").Select
    ActiveSheet.Paste

The thing i'm needing help on is creating a loop that if Column B's cell contents first two letters don't equal "J1" "J2" or "J3" then to delete that row.

I'm kind of confused on that bit.

thanks guys!

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[mattloflin]

    For i = 1 To newlastrow
    Select Case Sheets(NewX).Range("B" & i + 1).Text
    Case ""
        Rows(i + 1 & ":" & i + 1).Select
        Selection.Delete Shift:=xlUp
        i = i - 1
    End Select
    Next i

would it be something LIKE this? I have tried this and it doesn't work.

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[mattloflin]

    For i = 1 To newlastrow
    Select Case Sheets(newx).Range("B" & i + 1).Text
    Case (Right(Sheets(newx).Range("B" & i + 1).Text, 2)) <> "J1", "J2", "J3"
        Rows(i + 1 & ":" & i + 1).Select
        Selection.Delete Shift:=xlUp
        i = i - 1
    End Select
    Next i

I tried this and nothing got deleted.

Atleast I'm trying!

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[mattloflin]

Here is all my code

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlManual
    
Dim NewName As String
Dim x As String

x = Application.ActiveWorkbook.FullName
OldX = Application.ActiveWorkbook.Name
    
    ' Rename Full Filename
    If Right((x), 8) = " GTS.xls" Then
        NewName = Left((x), Len(x) - 8) & " GTS" & ".xls"
    Else
        NewName = Left((x), Len(x) - 4) & " GTS" & ".xls"
    End If
    
    'Add New Workbook / Save New Name
    Workbooks.Add
    ActiveWorkbook.SaveAs NewName
    newx = Application.ActiveWorkbook.Name
    
    'Copy and Paste Columns
    Windows(OldX).Activate
    Columns("A:A").Copy
    Windows(newx).Activate
    Columns("C:C").Select
    ActiveSheet.Paste
    Windows(OldX).Activate
    Columns("M:M").Copy
    Windows(newx).Activate
    Columns("B:B").Select
    ActiveSheet.Paste
    
    'Delete Empty Rows
    newlastrow = ActiveSheet.UsedRange.Rows.Count
    For i = 1 To newlastrow
        Sheets(newx).Range("A" & i + 1).Text = "Probe"
    Select Case Sheets(newx).Range("B" & i + 1).Text
    Case (Right(Sheets(newx).Range("B" & i + 1).Text, 2)) <> "J1", "J2", "J3"
        Rows(i + 1 & ":" & i + 1).Select
        Selection.Delete Shift:=xlUp
        i = i - 1
    End Select
    Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
ActiveWorkbook.Save

this is the section giving me trouble:

    'Delete Empty Rows
    newlastrow = ActiveSheet.UsedRange.Rows.Count
    For i = 1 To newlastrow
        Sheets(newx).Range("A" & i + 1).Text = "Probe"
    Select Case Sheets(newx).Range("B" & i + 1).Text
    Case (Right(Sheets(newx).Range("B" & i + 1).Text, 2)) <> "J1", "J2", "J3"
        Rows(i + 1 & ":" & i + 1).Select
        Selection.Delete Shift:=xlUp
        i = i - 1
    End Select
    Next i

it keeps saying "Subscript out of range" I have tried troubleshooting it just keeps saying it. I can't figure out the reason. i have tried record my own macro and everything.

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[SkipVought]

You have ActiveSheet and then Sheets(newx) that you are trying to SELECT in. Can't select in ANY sheet but the ActiveSheet.

However, I strongly advise against using the Select method. Fully qualify your ranges without selecting.

IMHO, you are going to ALOT of needless acrobatics in order to accomplish a VERY SIMPLE TASK.

Skip,

_{I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent!}

 

[mattloflin]

i'm trying to get the code functional before I go and work backwards to shorten it down. I don't know all the loops like a lot of people on here so actually it'd be better for me to see how it works then learn how to make it work better.

That's how I learn things. Do you have an "recommendations" on the part that i'm stuck on or just criticism in general (as always)

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[mattloflin]

    newlastrow = ActiveSheet.UsedRange.Rows.Count
    For i = 1 To newlastrow
        ActiveSheet.Range("A" & i + 1) = "Probe"
        Search = Left(ActiveSheet.Range("B" & i + 1), 2)
        If Search <> "J1" And Search <> "J2" And Search <> "J3" Then
            Rows(i + 1 & ":" & i + 1).Delete shift:=xlUp
            i = i - 1
        End If
    Next i
    Rows(1).Delete shift:=xlUp

That code works however it goes into an infinite loop. but if you end it in the middle it will look like I want it to look. i just don't get why it keps going.

One step closer.

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[AnotherHiggins]

I'd offer the same suggestion to one of your earlier threads:

Just copy the entire worksheet - to a new workbook if needed - rather than picking particular columns.

One you have all data on a new sheet, delete unused columns. Then insert a new Column A.

You can use Macro Recorder for those steps.

Don't loop through column A. You can enter a single value/string in a whole range of cells at one time.

Loop through column C and delete columns that don't match your criteria.

Also note that I am using a different strategy to find the last row.

Try this:

'...
' Recorded code to duplicate entire worksheet
'...

NewLastRow = Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
Range("A1:A" & NewLastRow).Value = "Probe"

Dim ocell As Range

For i = NewLastRow To 2 Step -1
    If Left(Range("c" & i), 2) <> "J1" And _
       Left(Range("c" & i), 2) <> "J2" And _
       Left(Range("c" & i), 2) <> "J3" Then
           Range(i & ":" & i).EntireRow.Delete
    End If
Next i

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[mattloflin]

All I had to do to your code Higgins was change the "c" to "b" and it worked perfect.

After adding a few lines of code to format the fields and save it at the same location it's all working great. Thanks guys you did awesome.

Thanks for making me do most the work so I get to learn alot.

I think AnotherHiggins and CK1999 are top of the list in my book. Skip knows a lot but is often to busy to help code.

- Matt

"Never Give a Sword to a Man Who Can't Dance

 

[SkipVought]

Matt,

My suggestion...

Select 
  'Probe' as WhateverHeadingYouWant
, [Column A Heading]
, [Column M Heading]
From [Sheet1$]
Where Left([Column A Heading],2) Not In ('J1','J2','J3')

could be working in your workbook in less than FIVE MINUTES.

No LOOPS.

Nice compact code. Easy to maintain. How is that, "...to busy to help code.?

Skip,

_{I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent!}