Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

How to automate the follwoing procedure in MS Excel 2003

Posted on 2009-12-16
21
Medium Priority
?
243 Views
Last Modified: 2012-05-08
I need to modify similar CSV in Excel files every day, columns are the same, the only variation is the data itself. When I record a macro it'll work on one file, but not on all of them. Here are the steps I take to modify the CSV file:

1a. Open input.csv file
2a. Sort by column D
3a. Select and copy all rows with "ACC90" In column D
4a. Paste it one line below the block of data

Work with pasted data in the second block:
1. Rename all instances of "ACC90" to "ACC9A" in Column D
2. Copy formulas from another spreadsheet, paste them in first row, column M in the new block
3. Paste columns M-P for all records down
4. Copy columns M,N for all records (row X to 1)
5. Delete values in row M,N in empty line between two blocks of data
6. Select all values in column N (new block)
7. Rename all instances of "B000?" in column N to "B0006"
8. Copy columns M,N and paste as data to columns D,H
9. Copy formulas from column P,Q in the first row of the second block
10. Paste this formula to every row below where either:
- Row in column J has a value
- Row in column P == 0
11. Copy all data in columns P,Q between first and last row in the second block
12. Paste this data as value in first row, column I in the second block
13. Copy all data in column O between first and last row in the second block
15. Paste it as value to first row in column G
16. Delete all entries in columns M-Q
17. Sort all by column B
18. Save as .csv
19. exit

I need the macro to dynamically find correct fields/ranges, for example step #3a may select A1:K9 or A4:k99 etc... Step 4a should find the last row with data and paste the selection two rown down (leaving one empty line between blocks).

input.csv - the original file
final.csv - modified file

Formulas from formula.xls are:
M1=+CONCATENATE(0,F1)
N1=+CONCATENATE("00",H1)
O1=+ROUND(G1/0.15*0.07,2)
P1 - blank
Q1=+ROUND(J1/0.15*0.07,2)

M2=+CONCATENATE(0,F2)
N2=+CONCATENATE("00",H2)
O2=+ROUND(G2/0.15*0.07,2)
P2=+ROUND(I2/0.15*0.07,2)
Q2 - blank

M3,4 N3,4 O3,4 P3,4 are the same as M-P in row 2

Thank you
Sub Test()
'
' Test Macro
' Macro recorded 12/16/2009 by coffinated
'

'
    ChDir "C:\Documents and Settings\coffinated\Desktop"
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\coffinated\Desktop\input.txt", Origin:=437, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True
    Columns("C:C").EntireColumn.AutoFit
    Columns("A:K").Select
    Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1:K23").Select
    Selection.Copy
    Selection.End(xlDown).Select
    Range("A41").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=27
    Range("D41").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "ACC9A"
    Range("D41").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FillDown
    Range("M41").Select
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\coffinated\Desktop\formulas.xls", Origin:= _
        xlWindows
    Range("M1:Q4").Select
    Selection.Copy
    Windows("input.txt").Activate
    ActiveSheet.Paste
    Range("M44:P44").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("M44:P63"), Type:=xlFillDefault
    Range("M44:P63").Select
    Range("M41:N41").Select
    Selection.AutoFill Destination:=Range("M1:N41"), Type:=xlFillDefault
    Range("M1:N41").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("M40:N40").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=9
    Application.WindowState = xlMinimized
    Range("H41:H63").Select
    Selection.Replace What:="B000?", Replacement:="B0006", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("M:M").Select
    Range("M31").Activate
    Selection.Copy
    Columns("F:F").Select
    Range("F31").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("N:N").Select
    Range("N31").Activate
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-45
    Columns("H:H").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=30
    Range("P41:Q41").Select
    ActiveWindow.SmallScroll ToRight:=-7
    Range("O35").Select
    Application.CommandBars("Task Pane").Visible = False
    Range("N42").Select
    ActiveWindow.SmallScroll ToRight:=-2
    Range("P42").Select
    Application.WindowState = xlMinimized
    Application.WindowState = xlMinimized
    Application.WindowState = xlMinimized
    Application.CutCopyMode = False
    Range("P41:Q41").Select
    Selection.Copy
    Range("P46").Select
    ActiveSheet.Paste
    Range("P52").Select
    ActiveSheet.Paste
    Range("P54").Select
    ActiveSheet.Paste
    Range("P56").Select
    ActiveSheet.Paste
    Range("P62").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("P41:Q63").Select
    Selection.Copy
    Range("I41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O41").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("M:Q").Select
    Range("M31").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.LargeScroll ToRight:=-1
    Columns("A:K").Select
    Range("A31").Activate
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ActiveWindow.SmallScroll Down:=-57
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    ActiveWindow.Close
End Sub

Open in new window

input.txt
final.txt
0
Comment
Question by:Coffinated
  • 10
  • 6
  • 3
  • +1
20 Comments
 
LVL 10

Expert Comment

by:bromy2004
ID: 26068420
Could you provide the Formulae from the other spreadsheet?

It seems to be a simple cleanup...just might take a few mins.
0
 
LVL 10

Expert Comment

by:bromy2004
ID: 26068423
Sorry my mistake...shoudl have read better....am working on it.
0
 
LVL 10

Expert Comment

by:bromy2004
ID: 26068435
It appears that the Input and Final File are both the same.

Could you re-provide the Input file?
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 5

Author Comment

by:Coffinated
ID: 26068666
bromy2004:

You're right input and output are the same, my mistake.... Attached is correct input.txt
input.txt
0
 
LVL 10

Expert Comment

by:bromy2004
ID: 26069097
I'm a bit confused about Steps 6 and 7.
Step 6 is Selecting Column N (Which Contains the Formula =CONCATENATE("00",H1)  )
Step 7 is Replacing "B000?" with B0006.
but all the values in Column N would be "00B000x" so would it still replace the B000? with B0006?
0
 
LVL 10

Expert Comment

by:bromy2004
ID: 26069205
Actually i'm getting a bit confused with a few of the Steps.

Could you outline what you want done, But not how you are doing it at the moment....if you understand what i mean.

For example, rather than say paste the formulas to the cells,
say "for all of Column F add a "0" in front."

Because VBA doesn't need to put formulas into another cell as we can edit the cell directly
(i.e
***Range("A1")="0" + Range("A1")***

is the same as
***=CONCATENATE("0",A1)***
in Excel, and then Copy Pasting to another Cell.

Understand?
0
 
LVL 3

Expert Comment

by:amrens
ID: 26070319
Try and send us the excel sheet with comments for easier understanding.
0
 
LVL 5

Author Comment

by:Coffinated
ID: 26076422
bromy2004:
Step 7: Replacing "B000?" with B0006 - there may be different accounts (B0002, B0002...B0005) starting with B000, all of them should be converted to B0006.

The formulas simply add "0" to columns M,N, and calculate percentage of the original value.

I am going to record a short video showing all steps needed to do the process, that should give you an idea of what needs to be done.
0
 
LVL 5

Author Comment

by:Coffinated
ID: 26077268
Attached are SWF and HTML files, download both and open excel.swf.html with your browser.
excel.swf.html
excel.swf
0
 
LVL 10

Accepted Solution

by:
bromy2004 earned 1500 total points
ID: 26077414
OK Got it.

Paste that into a new Sheet
Sub RunDaily()
Dim FileName As String
Dim MaxRow As Long, i As Long, j As Long
Dim origMaxRow As Long, origMaxCol As Long
Dim data

FileName = "C:\Documents and Settings\NathanB\Desktop\Experts Exchange\EE Accounts Macro\Input.txt"

'Open File
Workbooks.OpenText FileName:=FileName, DataType:=xlDelimited, TextQualifier:=xlTextQualifierDoubleQuote, Tab:=True, TrailingMinusNumbers:=True

MaxRow = ActiveSheet.UsedRange.Rows.Count + 1
origMaxRow = ActiveSheet.UsedRange.Rows.Count
origMaxCol = ActiveSheet.UsedRange.Columns.Count
data = ActiveSheet.UsedRange


'Run through entire File and make appropriate changes
For i = 1 To origMaxRow
  'Add 0 to Column F
  Cells(i, 6).Value = "0" + Cells(i, 6).Value
  'Add 00 to Column H
  Cells(i, 8).Value = "00" + Cells(i, 8).Value
  
  'ACC90 to ACC9A
  If Cells(i, 4) = "ACC90" Then
  ActiveSheet.Range(Cells(i, 1), Cells(i, ActiveSheet.UsedRange.Columns.Count)).Copy Destination:=ActiveSheet.Range(Cells(MaxRow, 1), Cells(MaxRow, ActiveSheet.UsedRange.Columns.Count))
  ActiveSheet.Range(Cells(MaxRow, 4).Address).Value = "ACC9A"
  
  'B000? to B0006
  If Cells(MaxRow, 8) = "00B000?" Then Cells(MaxRow, 8) = "00B0006"
  
  'Round Values
  Cells(MaxRow, 7).Value = Round((Cells(MaxRow, 7).Value / 0.15 * 0.07), 2)
  If Cells(MaxRow, 9).Value <> "" Then
    Cells(MaxRow, 9).Value = Round((Cells(MaxRow, 9).Value / 0.15 * 0.07), 2)
  End If
  
  If Cells(MaxRow, 10).Value <> "" Then
    Cells(MaxRow, 10).Value = Round((Cells(MaxRow, 10).Value / 0.15 * 0.07), 2)
  End If

  MaxRow = MaxRow + 1
  End If
  
Next i

'Autofit
Cells.EntireColumn.AutoFit

With ActiveWorkbook.Worksheets("input").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(Cells(1, 2), Cells(MaxRow - 1, 2)), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(Cells(1, 4), Cells(MaxRow - 1, 4)), SortOn:=xlSortOnValues, Order:=xlAscending
    .SetRange ActiveSheet.UsedRange
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

End Sub

Open in new window

Book1.xls
0
 
LVL 10

Assisted Solution

by:bromy2004
bromy2004 earned 1500 total points
ID: 26077421
Or use the attached Spreadsheet.

It wont save the final copy anywhere though.
if you need it to do that let me know.
0
 
LVL 5

Author Comment

by:Coffinated
ID: 26116147
bromy2004:

Run-time error '438':
Object does not support this property or method

Debug points to first line of "With" loop.

With ActiveWorkbook.Worksheets("input").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(Cells(1, 2), Cells(MaxRow - 1, 2)), SortOn:=xlSortOnValues, Order:=xlAscending
    .SortFields.Add Key:=Range(Cells(1, 4), Cells(MaxRow - 1, 4)), SortOn:=xlSortOnValues, Order:=xlAscending
    .SetRange ActiveSheet.UsedRange
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


I am running it using Excel 2003 if that makes any difference.
0
 
LVL 10

Assisted Solution

by:bromy2004
bromy2004 earned 1500 total points
ID: 26116626
Apologies.
The code i provided was for Excel 2007

Replace that Section for

    Columns("A:K").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("D1") _
        , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortOnValues, DataOption2:=xlSortOnValues

That will work on Excel '03 and '07
0
 
LVL 5

Author Comment

by:Coffinated
ID: 26117754
I'll try the new code first thing Monday morning, I should have mentioned excel 2003.
0
 
LVL 5

Author Comment

by:Coffinated
ID: 26213718
Sorry for the delay, the code looks good with exception of adding 0 and 00

 'Add 0 to Column F
  Cells(i, 6).Value = "0" + Cells(i, 6).Value
  'Add 00 to Column H
  Cells(i, 8).Value = "00" + Cells(i, 8).Value

It also doesn't work in Excel 2003, original values are not changed.
0
 
LVL 10

Expert Comment

by:bromy2004
ID: 26492039
Hi Coffinated,

change that section to
 'Add 0 to Column F
  Cells(i, 6).Value = "'0" + Cells(i, 6).Value
  'Add 00 to Column H
  Cells(i, 8).Value = "'00" + Cells(i, 8).Value
0
 
LVL 18

Assisted Solution

by:Cory Vandenberg
Cory Vandenberg earned 500 total points
ID: 26492040
If your cells are formatted as numeric, then leading zeros will not be stored.  In order to store leading zeroes you have to store the number as text.

'Add 0 to Column F
  Cells(i, 6).NumberFormat = "@"
  Cells(i, 6).Value = "0" & Cells(i, 6).Value
  'Add 00 to Column H
  Cells(i, 6).NumberFormat = "@"
  Cells(i, 8).Value = "00" & Cells(i, 8).Value
0
 
LVL 10

Expert Comment

by:bromy2004
ID: 26492044
@WarCrimes,
my change adds an apostrophe in front.
forcing it to stay as text, regardless if the user changes the formatting.
0
 
LVL 18

Expert Comment

by:Cory Vandenberg
ID: 26492050
Forgot to change the second one to Cells(i, 8).  Sorry bout that

'Add 0 to Column F
  Cells(i, 6).NumberFormat = "@"
  Cells(i, 6).Value = "0" & Cells(i, 6).Value
  'Add 00 to Column H
  Cells(i, 8).NumberFormat = "@"
  Cells(i, 8).Value = "00" & Cells(i, 8).Value

bromy's code does the same thing by putting the singel quote in front of the 0.....forgot about that one.  Always nice to know multiple ways to do things though, just in case.
0
 
LVL 18

Expert Comment

by:Cory Vandenberg
ID: 26492055
@bromy

Yup, we were posting basically the same time.

Cheers,
WC
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

810 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