Macro Formatting, Deleting, Summation and V Lookup

C

chrisjack

New member
Joined
Oct 22, 2012
Messages
15
Reaction score
0
Points
0
I have a spreadsheet that I have to modify manually to create a report couple of times a week. The process is time consuming but I believe it could be done faster if automated using my time effectively. On Sheet 1 the spreadsheet is from columns A – DO. These are the steps I take to create the report.

  1. Delete Columns B – J. Note: Every time you delete, the subsequent columns move to the left
  2. Delete Columns F – BG
  3. Delete Columns G – AJ
  4. Delete Columns I – L
  5. Delete Columns R – V
After all the deletion you will be left with data from Columns A – Q

  1. From columns G2 – Q fill in ALL blank cells with 0 in order for the V Lookup to work later on
  2. Create 2 new columns R and S and label them Sum1 & Sum respectively
  3. Sum up columns I through Q and put the answer in column R
  4. Copy the answers in column Sum1 from R2 all the way down to the last row and paste special value in column Sum from S2 all the way down
  5. Delete columns I - R
  6. On Sheet 2, a V Lookup of column A is done starting from A2. If the Material Number exist in column A of Sheet 1, copy the remainder of the data in that row from columns B – I till the last row. If no matching Material Number is found just populate cells B – I with “No Match”

Note:The size of the data varies from 100s to sometimes 10,000. I’m sure this process could be accomplished with a Macro. I will input the Material numbers every time on sheet 2 before running the macro. Thanks in advance for your help. Attached is a sample of the spreadsheet.
 

Attachments

  • D_Sample_111913.xls
    84 KB · Views: 30
Try:

Code: 
Sub RunMacro()

Application.ScreenUpdating = False
With Sheets("Sheet1")
    .Columns("B:J").Delete Shift:=xlToLeft
    .Columns("F:BG").Delete Shift:=xlToLeft
    .Columns("G:AJ").Delete Shift:=xlToLeft
    .Columns("I:L").Delete Shift:=xlToLeft
    .Columns("R:V").Delete Shift:=xlToLeft
    .Columns("G:Q").SpecialCells(xlCellTypeBlanks).Value = 0
    .Range("R1").Value = "Sum1"
    .Range("S1").Value = "Sum"
    .Range("R2").Formula = "=SUM(I4:Q2)"
    .Range("R2:R" & .Range("A1").CurrentRegion.Rows.Count).Resize.FillDown
    .Range("R2:R" & .Range("A1").CurrentRegion.Rows.Count).Copy
    .Range("S2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    .Columns("I:R").Delete Shift:=xlToLeft
End With
    With Sheets("Sheet2")
        .Range("B2").Formula = "=IFERROR(INDEX(Sheet1!B:B,MATCH($A2,Sheet1!$A:$A,0)),""No Match"")"
        .Range("B2:I2").Resize.FillRight
        .Range("B2:I" & .Range("A1").CurrentRegion.Rows.Count).Resize.FillDown
    End With
Application.ScreenUpdating = True
End Sub
 
Last edited:
Hi NBVC, you are a life saver. I am so excited after running your macro. It works perfectly. The only other question I have is will it work regardless of the size of data? Thank you very much.

Chris
 
chrisjack said:
Hi NBVC, you are a life saver. I am so excited after running your macro. It works perfectly. The only other question I have is will it work regardless of the size of data? Thank you very much.

Chris
Click to expand...
Yes it should. It uses the current region based on cell A1. So it basically captures all the cells in a rectangular region that are adjacent to each other starting from A1.
 
You must log in or register to reply here.
Back
Top