Solved

I need a Macro to Clean Unwanted Data (Rows and Columns) from a Spreadsheet

Posted on 2013-12-18
18
608 Views
Last Modified: 2013-12-19
I am writing a macro to clean up a spreadsheet accounting creates, so that it can be used as an Access table

mvidas already gave me 90% of what i need, but there are a couple of types of columns i still need to delete via the macro

1) I need to delete columns with Headers, but no data below them. For example, Row 1 is a header of a future month, but row 2 below it is blank.

2) I need to delete a column that is a summary column with the header "FYXX"

This would be great as a Related Question, but that feature seems to be removed
0
Comment
Question by:Rex85
  • 10
  • 8
18 Comments
 
LVL 35

Assisted Solution

by:mvidas
mvidas earned 500 total points
ID: 39727292
Hi Rex,

You could have just added it to the last question too, but it's not a problem. For the empty headers part, I added something to the intersect portion to start in row 2
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Application.WorksheetFunction.CountA(Intersect(Columns(i), ActiveSheet.UsedRange, Rows("2:" & Rows.Count))) = 0 Then
   Columns(i).Delete
  End If
 Next

Open in new window

For the summary column, you can modify the column searching loop
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Cells(1, i).Text Like "FY??" Then
   Columns(i).Delete
  End If
 Next

Open in new window

I use the "Like" operator there to look for FYXX (assuming XX is any year)
0
 

Author Comment

by:Rex85
ID: 39727509
the FY Column remover worked great.

The header column remover did not.

I realized that ONLY the 2nd row under those months is blank. (that's for sales, but they are future months)

However, they (accounting) do put zeroes in the future months for the other categories.

I am assuming that was the issue. I have included a picture to show you what it looks like.

thanks
Sample-of-future-months-to-delet.jpg
0
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
ID: 39727514
Hmmm.. maybe we could look for row 2 to be blank, and the rest to sum=0
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Len(Cells(2, i).Text) = 0 Then
   If Application.Sum(Intersect(Columns(i), ActiveSheet.UsedRange, Rows("2:" & Rows.Count))) = 0 Then
    Columns(i).Delete
   End If
  End If
 Next

Open in new window

Here, I'm checking the length of text of row 2 of each column to see if the length is zero. If it is, it essentially does a =SUM(A3:Axxx) for each column and looks to see if the result is zero. If both conditions exist, it deletes the column.
0
 

Author Comment

by:Rex85
ID: 39727526
Fantastic. Works great. I appreciate the explanations very much as well.

You mentioned in this i could have added it to the last question... is that a feature? I don't know how to do it.

I don't want to cheat you out of points trying to pull a scope creep.

I have a couple of other items I don't think i'll be able to figure out. I am obviously not that good, and time is of the essence on this, so I really appreciate your saving me literal days of frustration and time.
0
 

Author Closing Comment

by:Rex85
ID: 39727527
thank you!
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39727567
When I said you can add it to a question, I just mean to post a comment (like this) detailing what you need. Many experts may not like it, because of the point/scope thing you mentioned, but it really doesn't matter to me. The only risk is if I'm not around, then at least someone else can help you with a new question.

What I've done before while formatting someone else's reports like this is insert a new row 1, and creating a formula that is a bunch of nested IF() formulas, coming up with a TRUE or FALSE answer to later use to delete the column. As an example, if you were to add a new row 1, you could put in B1:
=IF(LEFT(B4,1)="Q",TRUE,IF(COUNTA(B2:B1000)=0,TRUE,IF(AND(LEN(B3)=0,SUM(B3:B1000)=0),TRUE,IF(AND(LEFT(B2,2)="FY",ISNUMBER(VALUE(MID(B2,3,2)))),TRUE,FALSE))))

That would check if row 4 (formerly 3) starts with Q, or if the column is blank, or if its a future date, or an FYXX header, and would show TRUE for any or all of the conditions met. Once you have a suitable formula for both row and column criteria, you could make the macro put those formulas in and delete based on the TRUE or FALSE value.

That might overcomplicate it for you, but that was how I used to do reformatting like this.
0
 

Author Comment

by:Rex85
ID: 39727629
Thanks

I am having a weird problem with the code that deletes blank columns. there are actually five or six sheets like this (which i am not sure are identical) so i am having to make a separate macor do each sheet. Once i know they work, i can figure out how best to conncec them.

Anyway... I am getting an "Invalid Procedure Call error" whn i try to run it on a different page. I copied the code, so it should be identical.

I have attached the erro code, the debugger screen, and the spreadsheet as it looks AFTER the macro has partially run and crashed, i.e., where it is stopping.
Error-1.jpg
Error-1-Debug.jpg
Error-1-Spreadsheet.jpg
0
 

Author Comment

by:Rex85
ID: 39727868
In trying to work around it, I found the other section of code that uses the same approach crashes as well... and deletes everything but the top row.

I have attached a screen shot of that debugger result as well
error-2-debug.jpg
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39727920
Puzzling, let me create another sample book and try again
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:Rex85
ID: 39727923
thanks.... I can't find any reason for it, but then I don't have a good grasp of the intersection method
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39727927
It just returns a range that is the intersect of two (or more) ranges. So if one was A1:D4 and the other was B2:F3, the intersect would be B2:C3
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39727940
I really can't figure out why it wouldn't be working, nor why you'd get "invalid procedure call" as the error..?

Can you try restarting excel? Or if no luck there, is it possible to attach a sample workbook?
0
 

Author Comment

by:Rex85
ID: 39729109
I will try both. It will take a bit to clean the spreadsheet of propietary info...
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39729117
I understand. What I've done in the past sometimes is highlight the cells that might contain proprietary details (avoiding cells with numbers, if possible, to keep the sum-of-zero thing workable), then control-h for find and replace. Put an asterisk (*) in the "find what" part, and just "abc" or something simple in the "replace with" part. That'll change any cell with something to abc
0
 

Author Comment

by:Rex85
ID: 39729119
Thanks... good idea
0
 

Author Comment

by:Rex85
ID: 39729539
OK.... I stripped as much as possible without changing the format. The numbers are made up.
Warranty-August-FY14-YR-Rates.xls
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39729712
Ok, I figured it out, it is because column A is blank, so the intersect of the usedrange is blank. I thought that could be the case, but assumed column A had something. No biggie, and this way I can make the script a little neater.

Take a look at this screenshot:
Desired output?
Is that what you wanted? If so, here is the code:
Sub SAPBEXonRefresh(queryID As String, resultArea As Range)

End Sub
Sub R_and_A_Clean_New_Files()
'
' R_and_A_Clean_New_Files Macro
'
 
 Dim i As Long

'Select Proper Work Sheet
 Sheets("Files").Activate
 
'Change the row here accordingly (currently looking in row 3)
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Left(Cells(8, i).Text, 1) = "Q" Then
   Columns(i).Delete
  End If
 Next
 
 'Change the column here according (currently looking at column D)
 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Left(Range("G" & i).Text, 1) = "%" Then
   Rows(i).Delete
  End If
 Next
 
 'look in the used cells in a column and delete blank columns
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Intersect(Columns(i), ActiveSheet.UsedRange) Is Nothing Then
   Columns(i).Delete
  ElseIf Application.WorksheetFunction.CountA(Intersect(Columns(i), ActiveSheet.UsedRange)) = 0 Then
   Columns(i).Delete
  End If
 Next

'Rex Additions 12/18/2013

'Delete Blank Rows
 'look in the used cells in a Row and delete blank rows
 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Intersect(Rows(i), ActiveSheet.UsedRange) Is Nothing Then
   Rows(i).Delete
  ElseIf Application.WorksheetFunction.CountA(Intersect(Rows(i), ActiveSheet.UsedRange)) = 0 Then
   Rows(i).Delete
  End If
 Next
 
 'One more pass at deleting % of sales 12/18/2013
 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Left(Range("E" & i).Text, 1) = "%" Then
   Rows(i).Delete
  End If
 Next
 
  'One more pass at deleting subtotals 12/18/2013
 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Left(Range("E" & i).Text, 1) = "T" Then
   Rows(i).Delete
  End If
 Next
 
 'Delete Leftover Header Rows and Left Columns
    Rows("1:5").Delete
    'Columns("A:B").Delete

'Add Sales Header to two columns
    Range("C2").FormulaR1C1 = "Sales"
    Range("D2").FormulaR1C1 = "Sales"

'Add Casegoods to Correct Column
    Range("B1").FormulaR1C1 = "Casegoods"

'Delete Column E (it's all blank)
    Columns("E").Delete

'Delete Column A (it's all blank)
    Columns("A").Delete
    
'Delete Blanks in Column C
 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Left(Range("C" & i).Text, 1) = "" Then
   Rows(i).Delete
  End If
 Next

'Delete FY Summary Columns (from mvidas)
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Cells(1, i).Text Like "FY??" Then
   Columns(i).Delete
  End If
 Next

'Delete Blank Month Columns (from mvidas)
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Len(Cells(2, i).Text) = 0 Then
   If Intersect(Columns(i), ActiveSheet.UsedRange) Is Nothing Then
    Columns(i).Delete
   ElseIf Application.Sum(Intersect(Columns(i), ActiveSheet.UsedRange, Rows("2:" & Rows.Count))) = 0 Then
    Columns(i).Delete
   End If
  End If
 Next
End Sub

Open in new window

You will probably want to put that in a normal code module, instead of on the worksheet module where it is. It shouldn't make a difference at runtime in this case, but it can in some instances. Unless it is a worksheet-level event or private function, its better to keep macros in normal modules.
0
 

Author Comment

by:Rex85
ID: 39730110
Fantastic. Thank you again!

I keep macros like this in my hidden personal worksheet. The file will be new every month from accounting, so I will run it from my Personal Macros.

Thank you VERY much.

Rex
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

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

707 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

16 Experts available now in Live!

Get 1:1 Help Now