Deleting Rows

[howard]

I have a workfile that uses a macro to import a file. I want all the rows of data to be deleted except the following information:

1) Where *** NEW VEHICLE SUMMARY *** appears In column A , I want this row plus 17 rows below this

2) Where***USED VEHICLE SUMMARY** appears In column A , I want this row plus 19 rows below this

I want ---------- and ========== cleared where these appears


I would like VBA code that will do this for me



Howard

 

[golfbum71]

In order for it to work, the wording needs to be completely accurate:
is the wording for column a--with exactly 3 *s on each side with a space, and does the used vehicle summary only have 2 stars on the right side with no spaces on either side of the stars?

Is ---------- exactly 10 hyphens and ========== exactly 10 equals?
Are the hyphens and equals the only thing in the A cell?

It can be done, but I'd need to know this to make sure it works.

Cheers,
Geoff

 

[howard]

deleting rows

Hi Geoff

Your interpretation is correct. Look forward to receiving your code so that I can test the code.

Regards

Howard

 

[golfbum71]

Deleting lines based on condition

This will get rid of the extra lines as you have mentioned them:

Sub DeleteExtraLines()

Application.ScreenUpdating = False

Sheets("Sheet1").Select
LastRow = Range("A65000").End(xlUp).Row

For x = LastRow To 1 Step -1

If Cells(x, 1) = "----------" Then
    Rows(x & ":" & x).EntireRow.Select
    Selection.Delete Shift:=xlUp
End If

If Cells(x, 1) = "==========" Then
    Rows(x & ":" & x).EntireRow.Select
    Selection.Delete Shift:=xlUp
End If

Next x

Then you can run this:

Sub DeleteExtras()

LastRow = Range("A65000").End(xlUp).Row 'Sets the end of the delete section

For x = Range("A65000").End(xlUp).Row To 1 Step -1
    
    'Determine where to start deleting from
    
    If Cells(x, 1) = "*** NEW VEHICLE SUMMARY ***" Then
        FirstRow = x + 17
    End If
    
    If Cells(x, 1) = "***USED VEHICLE SUMMARY**" Then
        FirstRow = x + 19
    End If

If FirstRow <> "" Then '
    
    If LastRow > FirstRow Then
        Rows(FirstRow & ":" & LastRow).EntireRow.Select
        Selection.Delete Shift:=xlUp
        LastRow = x - 1 'Sets the new end for the next delete
    End If

End If
Next x

    
End Sub

The --- and === lines may be deleted if you use the above code first.

Good luck,
Hope it helps,
Geoff

 

[howard]

Hi Geoff

Thanks for the help. The code is working, but I need one more change which I overlooked when posing my query.

I need all the rows above *** NEW VEHICLE SUMMARY *** to be deleted and need 8 rows to be inserted between TOTAL NET (PROFIT)/LOSS and
***USED VEHICLE SUMMARY**

After running the macro, TOTAL NET (PROFIT)/LOSS and ***USED VEHICLE SUMMARY** are below one another. I need these seperated by at least 8 rows

Your assistance will be most appreciated

Howard

Perep1&2.xls
	A	B	C	D	E
433	***NEWVEHICLESUMMARY***
434
435	TOTALNETSALES
436	TOTALCOSTOFSALES
437	TOTALOVERALLOWANCE
438
439	TOTALFRONTENDG/PROFIT
440	TOTALBACKENDG/PROFIT
441	TOTALG/PROFITADJUSTMENT
442
443	TOTALADJ'DGROSSPROFIT
444	EXPENSES-VARIABLES
445	EXPENSES-PERSONNEL
446	EXPENSES-SEMI/FIXED
447	EXPENSES-TOTAL
448
449	TOTALNET(PROFIT)/LOSS
450	***USEDVEHICLESUMMARY**
Sheet1

 

[golfbum71]

More stuff

Sub DeleteExtras()

LastRow = Range("A65000").End(xlUp).Row 'Sets the end of the delete section

For x = Range("A65000").End(xlUp).Row To 1 Step -1
    
    'Determine where to start deleting from
    
    If Cells(x, 1) = "*** NEW VEHICLE SUMMARY ***" Then
        FirstRow = x + 17
    End If
    
    If Cells(x, 1) = "***USED VEHICLE SUMMARY**" Then
        FirstRow = x + 19
    End If

If FirstRow <> "" Then '
    
    If LastRow > FirstRow Then
        Rows(FirstRow & ":" & LastRow).EntireRow.Select
        Selection.Delete Shift:=xlUp
        LastRow = x - 1 'Sets the new end for the next delete
    End If

    If Cells(x, 1) = "***USED VEHICLE SUMMARY**" Then
        For y = 1 To 8
            Rows(x & ":" & x).Select
            Selection.Insert Shift:=xlDown
        Next y
    End If

End If

Next x

For z = 1 To Range("A65000").End(xlUp).Row
    If Cells(z, 1) = "*** NEW VEHICLE SUMMARY ***" Then
        FirstRow = 1
        LastRow = z - 1
        Rows(FirstRow & ":" & LastRow).EntireRow.Select
        Selection.Delete Shift:=xlUp
        Exit For
    End If
Next z

 

[howard]

Hi Geoff

Thanks for the help. Macro working perfectly

Regards



Howard