Solved

Need macro help -Excel

Posted on 2011-09-11
26
178 Views
Last Modified: 2012-05-12
I am new to vb macros . I needed a macro which would delete whole cell starting with some expression.I have modified an existing  macro which i found on web site. However these are around 30 variables which i need to delete at one go in worksheet. It runs fine for few
variables but if i try to run with all 30 variables it throws compile error and syntax error. Point to be notes that if the micro is in 1 line thr macro runs fine without any issue.

Sub Delete_rows()

With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Left(Cells(i, 1), 6) = "Status" Or Left(Cells(i, 1), 5) = "WorkID" Or Left(Cells(i, 1), 7) = "P_Owners" Or Left(Cells(i, 1), 10) = "WorkStatus" Or Left(Cells(i, 1), 11) = "WorkIDs" Or Left(Cells(i, 1), 14) = "FunctionTitles" Or Left(Cells(i, 1), 19) = "FunctionIDAncestors" Or Left(Cells(i, 1), 10) = "DateCreate" Or Left(Cells(i, 1), 10) = "NameCreate" Or Left(Cells(i, 1), 12) = "DateLastEdit" Or Left(Cells(i, 1), 12) = "NameLastEdit" Or Left(Cells(i, 1), 9) = "$WebFlags" Or Left(Cells(i, 1), 15) = "$ConflictAction" Or Left(Cells(i, 1), 6) = "Phases" Or Left(Cells(i, 1), 7) = "Subform" Or Left(Cells(i, 1), 8) = "NumTests" Or Left(Cells(i, 1), 15) = "DescriptionText" Or Left(Cells(i, 1), 12) = "ExecCycleIDs" Or Left(Cells(i, 1), 15) = "ExecCycleTitles" Or Left(Cells(i, 1), 18) = "ExecAllCycleTitles" Or Left(Cells(i, 1), 15) = "ExecAllCycleIDs" Or Left(Cells(i, 1), 17) = "ExecAllResults_id" Or Left(Cells(i, 1), 15) = "ExecAllBuilds_id" Or Left(Cells(i, 1), 9) = "ExecAllid" Or Left(Cells(i, 1), 18) = "WorkExecA
llDefects" Or Left(Cells(i, 1), 15) = "WorkEventLog001" Or Left(Cells(i, 1), 14) = "Work_OldValues" Or Left(Cells(i, 1), 14) = "$WorkUpdatedBy" Or Left(Cells(i, 1), 14) = "$WorkRevisions" Then
Cells(i, 1).EntireRow.Delete
    End If
  
  Next i
  
        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub

Open in new window


Woudl appreciate the help.
0
Comment
Question by:devlearn
  • 12
  • 9
  • 4
26 Comments
 
LVL 33

Expert Comment

by:Norie
ID: 36519332
Are the terms you are checking for the only thing in the cells?

eg is it just 'Status' on it's own and not 'Status' followed by something else.

Whichever, this code will delete all the rows that contain one of the terms
Option Explicit


Sub Delete_rows()
Dim rng As Range
Dim arrTerms
Dim I As Long
Dim J As Long

    arrTerms = Array("Status", "WorkID", "POwners", "WorkStatus", _
                     "WorkIDs", "FunctionTitles", "FunctionIDAncestors", _
                     "DateCreate", "NameCreate", "DateLastEdit", _
                     "NameLastEdit", "$WebFlags", "$ConflictAction", _
                     "Phases", "Subform", "NumTests", _
                     "DescriptionText", "ExecCycleIDs", "ExecCycleTitles", _
                     "ExecAllCycleTitles", "ExecAllCycleIDs", "ExecAllResultsid", _
                     "ExecAllBuildsid", "ExecAllid", "WorkExecAllDefects", _
                     "WorkEventLog001", "WorkOldValues", "$WorkUpdatedBy", "$WorkRevisions")

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        For I = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1


            Set rng = Cells(I, 6)
            For J = LBound(arrTerms) To UBound(arrTerms)

                If rng Like arrTerms(J) & "*" Then
                    rng.EntireRow.Delete
                End If
            Next J

        Next I

        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub

Open in new window

0
 

Author Comment

by:devlearn
ID: 36519433
Thanks for the quick reply.Appreciate it. However answer to the question you have asked as beloe
For e.g " Each row has Starting word as "Status: and indeed followed by few more words(Strings) which is followed by word status. Here i am trying to search only the word which will be constant and then delete. Hope this help. However i tried using your script but it seems it did not delte the whole row. Though the code ran properly without any error. Let me know if u want more information
0
 
LVL 33

Expert Comment

by:Norie
ID: 36519470
Slight mistake in the code, though it would have caused an error rather than the code doing nothing.

Here's what the loop should be.
        For I = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1


            Set rng = Cells(I, 6)
            For J = LBound(arrTerms) To UBound(arrTerms)

                If rng Like arrTerms(J) & "*" Then
                    rng.EntireRow.Delete
                    Exit For
                End If
            Next J

        Next I

Open in new window

By the way, is there data in column A?
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36520647
>>Each row has Starting word as "Status:

* Since your If statement is looking at the left-most characters, I don't think any of the conditions will be met other than "Status" -- perhaps all rows are being deleted.  It would help if you posted a workbook with example data.

* Even if your rows don't start with "Status:", you have invalid lengths for the character string literals you are using.
For example:
Left(Cells(i, 1), 5) = "WorkID"
should probably be
Left(Cells(i, 1), 7) = "WorkID"

* The following code uses a dictionary object for word matching and the Split() function for column 6 parsing.
Option Explicit

Public Sub DelRows()
    Dim dicWords As Object
    Dim I As Long
    Dim J As Long
    Dim rng As Range
    
    Set dicWords = CreateObject("scripting.dictionary")
    
    dicWords.Add "Status", 1
    dicWords.Add "WorkID", 1
    dicWords.Add "P_Owners", 1
    dicWords.Add "WorkStatus", 1
    dicWords.Add "WorkIDs", 1
    dicWords.Add "FunctionTitles", 1
    dicWords.Add "FunctionIDAncestors", 1
    dicWords.Add "DateCreate", 1
    dicWords.Add "NameCreate", 1
    dicWords.Add "DateLastEdit", 1
    dicWords.Add "NameLastEdit", 1
    dicWords.Add "$WebFlags", 1
    dicWords.Add "$ConflictAction", 1
    dicWords.Add "Phases", 1
    dicWords.Add "Subform", 1
    dicWords.Add "NumTests", 1
    dicWords.Add "DescriptionText", 1
    dicWords.Add "ExecCycleIDs", 1
    dicWords.Add "ExecCycleTitles", 1
    dicWords.Add "ExecAllCycleTitles", 1
    dicWords.Add "ExecAllCycleIDs", 1
    dicWords.Add "ExecAllResults_id", 1
    dicWords.Add "ExecAllBuilds_id", 1
    dicWords.Add "ExecAllid", 1
    dicWords.Add "WorkExecAllDefects", 1
    dicWords.Add "WorkEventLog001", 1
    dicWords.Add "Work_OldValues", 1
    dicWords.Add "$WorkUpdatedBy", 1
    dicWords.Add "$WorkRevisions", 1


    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        For I = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            
            Set rng = Cells(I, 6)

            If Len(rng.Value) = 0 Then
            Else
                If dicWords.exists(Split(rng.Value, " ")(0)) Then
                    rng.EntireRow.Delete
                End If
            End If
        Next

        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub

Open in new window

0
 
LVL 33

Expert Comment

by:Norie
ID: 36522202
The code I posted should work if the strings are at the start of the cell values.

The only thing can think that could be changed would be to use rng.Value.

Also, if you want to see if the string is within a cell you can add another wildcard.

So the If would look like this, I've added UCase to deal with any problem with the cases not matching.
If UCase(rng.Value) Like UCase("*" & arrTerms(J) & "*") Then

Open in new window


By the way, none of this will work unless you are looping through the right rows, and that depends on the data in column A which you are using to find the last row of data.
0
 

Author Comment

by:devlearn
ID: 36523531
Seems i have made wrong statement. Hence the baove code wont work. I tried intial with the above code which i tried on the very first coment like below and it seemed worked. Got the trick with the with putting "_" at the end of the line.

However i wish to get the end result as in attached excel. Stage 1 is the excel sheet which is initial raw data. After i run first macro to delete all unnecesary data except rows containing steps and expected data. Stage 3 is the excel tab where my final consumption would be .


Please see stage 1 tab where rows marked with yellow color should be left out .All other should be deleted. Stage 2 tells me after i run the macro. On top i should i have 3rd macro which should pu tthe titile and steps and expected result as required.

Hope this helps.
pump.xls
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36523940
what is the strange character in A45?

You've got the entire row highlighted for your 'keep' rows.  Do you only need columns A and B values?

This code transforms the data in the given worksheet.
Option Explicit

Public Sub ExtractTitleAndSteps()
    Dim rngFind As Range
    Dim rngSteps As Range
    Dim strTitle As String
    Dim wksTemp As Worksheet
    Dim wksCurrent As Worksheet
    
    Set wksCurrent = ActiveSheet
    Set rngFind = ActiveSheet.Range("A:A").Find("Title: ")
    If rngFind Is Nothing Then
        MsgBox "No title found"
        Exit Sub
    Else
        strTitle = rngFind.Value
        strTitle = Trim(Mid$(strTitle, Len("Title: ") + 1))
    End If
    
    Set rngFind = ActiveSheet.Range("A:A").Find("Steps")
    If rngFind Is Nothing Then
        MsgBox "No steps found"
        Exit Sub
    Else
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Set rngSteps = ActiveSheet.Range(rngFind, rngFind.End(xlDown).Offset(0, 1))
        Set wksTemp = Application.Worksheets.Add
        wksTemp.Range("A1").Value = strTitle
        rngSteps.Copy wksTemp.Range("B1", wksTemp.Range("B1").Offset(rngSteps.Rows.Count, rngSteps.Columns.Count))
        wksCurrent.Range("A:B").Value = vbNullString
        wksCurrent.Range("A1", wksCurrent.Range("A1").Offset(rngSteps.Rows.Count, rngSteps.Columns.Count + 1)).Value = _
                wksTemp.Range("A1", wksTemp.Range("A1").Offset(rngSteps.Rows.Count, rngSteps.Columns.Count + 1)).Value
        wksTemp.Delete
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If
    
End Sub

Open in new window

0
 
LVL 33

Expert Comment

by:Norie
ID: 36524021
The problem is that in the original code it was looking in column 6 (F) but the data is in column 1 (A) on the worksheet.

Also none of the values you were looking for are on the worksheet.

Use aikimark's code.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36524036
rephrase: Problem description in question text does not match data in sample workbook.

Note to future readers: Ignore my earlier solution suggestion: http:#36520647
0
 

Author Comment

by:devlearn
ID: 36524258
Thanks it seems working . got stuck with 1 issue where . If i have more that 1 those scenarios i can just rearrange worksheet with only the first one  . I pasted another set exact below the first one  and it seems picking only the first one. Would it possible if i have 100 scenario below as well it would do the same one below the another? Appreciate for the help you provided.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36524333
@devlearn

As a rule of thumb, the answer you get depends on the question you ask.  You posted a workbook with a single set of steps.  If, based on your comment, your actual data does not resemble the sample workbook data, then you should post another workbook that accurately resembles the actual data.
0
 

Author Comment

by:devlearn
ID: 36524410
I agree . Apologies if it went in wrong direction. i anticipated it would be understood . Since i can copy and paste the same content one bleow the another. Anyway i will put the same in attachment . Hope this is ok. Also since this worked like what i originally asked i would accept this as a solution . I will add another question if this is not the rule.

Also please note that is are the sample and i do not wish to share the real date. Hope you understand Note that i have added pump_v2 which does have a sample scenarios as i described earlier

Thanks again
pump-v2.xls
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:devlearn
ID: 36524465
I've requested that this question be closed as follows:

Accepted answer: 0 points for devlearn's comment http:/Q_27302224.html#36524410
Assisted answer: 250 points for aikimark's comment http:/Q_27302224.html#36520647
Assisted answer: 250 points for aikimark's comment http:/Q_27302224.html#36523940

for the following reason:

Worked as desired
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36524466
@devlearn

>>i have added pump_v2 which does have a sample scenarios

No.  The workbook does not have multiple sets of steps.  Please repost with sample scenarios, even if the data is made up.

I am objecting to your close request, since you don't yet have code that will transform your actual data.
0
 

Author Comment

by:devlearn
ID: 36524615
I am reposting the sample date . See attached .

tab1 is the original dump . tab  2 should come as output if i run macro to delete the unnecessary rows in tab 1. tab 3 should be the actual stuff coming out of tab 2. OR it could come in 1 go itself which is deleting the unnecessary rows and convert the actual output as described in the tab 3.

Hope this is clear.
pump-v3.xls
0
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
ID: 36525017
This seems to work for me.

Option Explicit

Public Sub ExtractTitleAndSteps()
    Dim rngFind As Range
    Dim rngFirstFind As Range
    Dim rngSteps As Range
    Dim rngTgt As Range
    Dim strTitle As String
    Dim wksTemp As Worksheet
    Dim wksCurrent As Worksheet
    
    Set wksCurrent = ActiveSheet
    Set rngFind = wksCurrent.Range("A:A").Find("Title: ")
    If rngFind Is Nothing Then
        MsgBox "No title found"
        Exit Sub
    Else
        Set rngFirstFind = rngFind
    End If
    
    Set wksTemp = Application.Worksheets.Add
    Set rngTgt = wksTemp.Range("A1")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Do Until rngFind Is Nothing
        strTitle = rngFind.Value
        Set rngFind = wksCurrent.Range(rngFind, wksCurrent.Range("A:A").Rows(wksCurrent.Rows.Count).End(xlUp)).Find("Steps", rngFind)
        If rngFind Is Nothing Then
            MsgBox "No steps found following " & strTitle
            Exit Sub
        Else
            Set rngSteps = wksCurrent.Range(rngFind, rngFind.End(xlDown).Offset(0, 1))
            rngTgt.Value = strTitle
            rngSteps.Copy wksTemp.Range(rngTgt.Offset(0, 1), rngTgt.Offset(rngSteps.Rows.Count, rngSteps.Columns.Count + 1))
        End If
        
        Set rngFind = wksCurrent.Range(rngFind, wksCurrent.Range("A:A").Rows(wksCurrent.Rows.Count).End(xlUp)).Find("Title: ", rngFind)
        If rngFind Is Nothing Then
        Else
            If rngFind.Address = rngFirstFind.Address Then
                Exit Do
            End If
        End If
        Set rngTgt = rngTgt.Offset(rngSteps.Rows.Count + 1)
    Loop
    
    wksCurrent.Range("A:B").Value = vbNullString
    
    wksCurrent.Range("A1", wksTemp.Cells.SpecialCells(xlCellTypeLastCell).Address).Value = _
            wksTemp.Range("A1", wksTemp.Cells.SpecialCells(xlCellTypeLastCell).Address).Value
    wksTemp.Delete

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Open in new window

0
 

Author Comment

by:devlearn
ID: 36529463
Hi

Thanks for the input. I tried with the above code. However i can see first scenario getting missed . .Am i missing something? The last two out of three are getting populated correctly .
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36529563
Did you run the code against the workbook you posted?
0
 

Author Comment

by:devlearn
ID: 36529873
Yes i ran the same against the workbook i posted earlier.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36529911
When I run it, the code produces three sections of steps.  What does it do on your system?
0
 

Author Comment

by:devlearn
ID: 36530244
I am attaching the output . I assume you cal also see the attached code as well here .
try1.xls
0
 
LVL 45

Expert Comment

by:aikimark
ID: 36530287
@devlearn

This file is the file after I've run the code.  I see three sections.

btw...what is the active worksheet when you started your test?
pump-v4.xls
0
 

Author Comment

by:devlearn
ID: 36530409
My fault. I ran it again .Seems i was doing something wrong . It worked as expected. Thanks a lot for your patient in resolving the issue. Appreciate your help.Thanks again
0
 

Author Comment

by:devlearn
ID: 36530566
I've requested that this question be closed as follows:

Accepted answer: 0 points for devlearn's comment http:/Q_27302224.html#36530409
Assisted answer: 500 points for aikimark's comment http:/Q_27302224.html#36525017

for the following reason:

Thanks . It Worked
0
 

Author Closing Comment

by:devlearn
ID: 36530764
Accepting this as Solution
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now