Report macro

Brinda · Aug 5, 2014

Hi Team,

I am trying to develop a macro to cut the second part of the report which is present in the existing sheet and then by doing vlook up to insert those values in the existing report.

Explanation:

I have a report which is split into two parts. The first part starts from A1 and then second part starts from row named PAGE 2. The second part of the report consists of 15 columns and the first part of the reports consists of 30 columns. I have to insert 14 columns in the first part of the report i.e. have to insert columns C31-C44 from second part into first set of report after C30.
One column is unique between both set of reports (C8) using which vlookup has to be done and values inserted.
Have attached a sample report and below is the coding that i am using.

My problem is that the columns are being inserted however the entire report is being moved to AZ . The newly inserted columns must appear in the original report after C30 and before U1. After inserting columns and doing vlookup --> convert to values the second part of the report must be deleted.

Can anyone please help .

Code:

Sub check()
'
' check Macro
'
'
  Columns("AE:AE").Select
  Range("AE3").Activate
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Selection.Insert Shift:=xlToRight
  Range("AE15").Select
  Sheets("Sheet1").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.Copy
  Sheets("Report").Select
  ActiveSheet.Paste
  Range("H16").Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("L3587").Select
  Selection.End(xlUp).Select
  Range("L16").Select
  Selection.End(xlToRight).Select
  Range("AE16").Select
  ActiveSheet.Paste
  Range("AF16").Select
  ActiveWindow.SmallScroll ToRight:=17
  Application.CutCopyMode = False
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet1!C1:C2,2,0)"
  Range("AG16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Sheet1!C1:C3,3,0)"
  Range("AH16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Sheet1!C1:C4,4,0)"
  Range("AI16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],Sheet1!C1:C5,5,0)"
  Range("AJ16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Sheet1!C1:C6,6,0)"
  Range("AK16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Sheet1!C1:C7,7,0)"
  Range("AL16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],Sheet1!C1:C8,8,0)"
  Range("AM16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],Sheet1!C1:C9,9,0)"
  Range("AN16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],Sheet1!C1:C10,10,0)"
  Range("AO16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-10],Sheet1!C1:C11,11,0)"
  Range("AP16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-11],Sheet1!C1:C12,12,0)"
  Range("AQ16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-12],Sheet1!C1:C13,13,0)"
  Range("AR16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-13],Sheet1!C1:C14,14,0)"
  Range("AS16").Select
  ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-14],Sheet1!C1:C15,15,0)"
  Range("AS17").Select
  Selection.End(xlToLeft).Select
  Selection.End(xlDown).Select
  Range("AF3609:AS3609").Select
  Range(Selection, Selection.End(xlUp)).Select
  Selection.FillDown
  ActiveWorkbook.Save
  Selection.Copy
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Columns("AE:AE").Select
  Range("AE3591").Activate
  Application.CutCopyMode = False
  Selection.Delete Shift:=xlToLeft
  Range("A1:AY1").Select
  ActiveWorkbook.Save
End Sub

Luke M · Aug 5, 2014

Would this work for you?

Code:

Sub MoveReport()
Dim pg2 As Range
Dim part2Report As Range

'Define where part 2 is
Set pg2 = Range("A:A").Find("PAGE 2")
Set pg2 = pg2.Offset(2, 1)
Set part2Report = Range(pg2, pg2.End(xlToRight).End(xlDown))

Application.ScreenUpdating = False

'Insert the needed columns
Range("AE1").Resize(1, part2Report.Columns.Count).EntireColumn.Insert

'Move the data
part2Report.Cut
ActiveSheet.Paste Destination:=Range("AE15")

Application.ScreenUpdating = True


End Sub

Brinda · Aug 6, 2014

Thanks a lot for the modified code Luke

The columns are getting inserted in the first part of the report as required in the correct place.

However One column is unique between both set of reports (C8) using which vlookup has to be done and then values inserted.
Reason behind this is the first set of report contains same data in C8 repeated multiple times (eg: Student roll no is in C8, the marks secured by the student for each subject will get repeated in the subsequent rows in first part of the report.
Second part of the report contains details which wil not be repeated (eg: School, Class, Sec etc.) Hence a vlook up has to be made b/w two reports using id in C8.

I would be very grateful if you can please provide a modified coding for this scenario.

Thanks in advance

Luke M · Aug 6, 2014

Ah. Okay, going wiht the VLOOKUP approach then.

Code:

Sub MoveReport()
Dim pg2 As Range
Dim part2Report As Range
Dim destRange As Range
Dim part2Row As Long

'Define where part 2 is
Set pg2 = Range("A:A").Find("PAGE 2")
part2Row = pg2.Row
Set pg2 = pg2.Offset(2, 1)
Set part2Report = Range(pg2, pg2.End(xlToRight).End(xlDown))

Application.ScreenUpdating = False

'Insert the needed columns
Range("AE1").Resize(1, part2Report.Columns.Count).EntireColumn.Insert

'Move the data
With part2Report
    .Rows(1).Cut
    ActiveSheet.Paste Destination:=Range("AE15")
    Set destRange = Range("AE16", Cells(part2Row - 1, Range("AE15").Offset(0, .Columns.Count - 1).Column))
   
    destRange.Formula = _
        "=VLOOKUP($H16," & .Offset(0, -1).Resize(, .Columns.Count + 1).Address(True, True) & ",COLUMN(B$2),FALSE)"
    destRange.Value = destRange.Value
    .Clear
End With


Application.ScreenUpdating = True


End Sub

Brinda · Aug 7, 2014

Thanks a million Luke, It is working perfectly

Just one final modification,
after inserting the columns and pasting values via vlook up, the pg2 details i.e starting from PAGE 2 and C8 values must be deleted, is it possible.

Sorry for incovenience caused

Please help

Luke M · Aug 7, 2014

Adding one more line then...

Code:

Sub MoveReport()
Dim pg2 As Range
Dim part2Report As Range
Dim destRange As Range
Dim part2Row As Long

'Define where part 2 is
Set pg2 = Range("A:A").Find("PAGE 2")
part2Row = pg2.Row
Set pg2 = pg2.Offset(2, 1)
Set part2Report = Range(pg2, pg2.End(xlToRight).End(xlDown))

Application.ScreenUpdating = False

'Insert the needed columns
Range("AE1").Resize(1, part2Report.Columns.Count).EntireColumn.Insert

'Move the data
With part2Report
    .Rows(1).Cut
    ActiveSheet.Paste Destination:=Range("AE15")
    Set destRange = Range("AE16", Cells(part2Row - 1, Range("AE15").Offset(0, .Columns.Count - 1).Column))
   
    destRange.Formula = _
        "=VLOOKUP($H16," & .Offset(0, -1).Resize(, .Columns.Count + 1).Address(True, True) & ",COLUMN(B$2),FALSE)"
    destRange.Value = destRange.Value
    .Clear
End With

'Clear out old info
Range(part2Row & ":65536").EntireRow.Delete

Application.ScreenUpdating = True


End Sub

Brinda · Aug 7, 2014

Perfect
Thank u very much
You have saved a lot of time for me

Brinda · Aug 7, 2014

Luke, can this code be modified to put the code in a separate file, then select the file from a folder and run this macro.

Kindly assist

Luke M · Aug 7, 2014

Currently, the code does not specify a worksheet or workbook, so you could run it on any open workbook. If you want to include the opening of the file with the macro, copy this function into a regular module

Code:

Private Function RetrieveFileName()
'obtained from:
'http://www.ozgrid.com/VBA/ExcelsDialogBoxes.htm

'Uncomment the latter half if macro-enabled workbooks need to be an option
Const myFilter      As String = "Worksheets (*.xlsx),*.xlsx" ' ,Worksheets (*.xlsm),*.xlsm"
Dim sFileName       As String
   
    'Change current folder to be wherever this file is stored
    ChDir ThisWorkbook.Path
   
    'Show the open dialog and pass the selected file name to the String variable "sFileName"
    sFileName = Application.GetOpenFilename(FileFilter:=myFilter, Title:="Multi Worksheet Import", MultiSelect:=False)

    'They have cancelled.
    If sFileName = "False" Then Exit Function

    RetrieveFileName = sFileName
End Function

and then at the beginning of your code, put

Code:

Dim impPath as String
impPath = RetrieveFileName()
If impPath = "" Then Exit Sub 'User cancelled
Workbooks.Open(impPath)

and that will open up the workbook for you.

Brinda · Aug 8, 2014

Thanks Luke

the code is working perfectly as expected

Brinda · Aug 11, 2014

Hi Luke,

Sorry for comin back again.

The reporting format is modified a little bit.
Now after column C25 the data from second part of the report PAGE 2 columns C26-C40 has to be inserted between C25 and C41.Vlookup between two reports has to be done using C8
When the above code is run, the columns are not getting inserted continuously in the right place.

Can you please help me here.

Revised sample file attached

Luke M · Aug 11, 2014

Sure thing. We'll use a new variable called "myCol" and have it read the first value in our Page 2 report. this will let us know which column we need to go into. All subsequent references will use this variable. Full code

Code:

Sub MoveReport()
Dim pg2 As Range
Dim part2Report As Range
Dim destRange As Range
Dim part2Row As Long
Dim myCol As Long
Dim impPath As String
impPath = RetrieveFileName()
If impPath = "" Then Exit Sub 'User cancelled
Workbooks.Open (impPath)

'Define where part 2 is
Set pg2 = Range("A:A").Find("PAGE 2")
part2Row = pg2.Row
Set pg2 = pg2.Offset(2, 1)
Set part2Report = Range(pg2, pg2.End(xlToRight).End(xlDown))

'-------NEW EDIT----------
'Figure out which column our new data is going into
myCol = Right(pg2.Value, Len(pg2.Value) - 1)

Application.ScreenUpdating = False

'Insert the needed columns
Cells(1, myCol).Resize(1, part2Report.Columns.Count).EntireColumn.Insert

'Move the data
With part2Report
    .Rows(1).Cut
    ActiveSheet.Paste Destination:=Cells(15, myCol)
    Set destRange = Range(Cells(16, myCol), Cells(part2Row - 1, Cells(15, myCol).Offset(0, .Columns.Count - 1).Column))
   
    destRange.Formula = _
        "=VLOOKUP($H16," & .Offset(0, -1).Resize(, .Columns.Count + 1).Address(True, True) & ",COLUMN(B$2),FALSE)"
    destRange.Value = destRange.Value
    .Clear
End With

'Clear out old info
Range(part2Row & ":65536").EntireRow.Delete

Application.ScreenUpdating = True


End Sub

Private Function RetrieveFileName()
'obtained from:
'http://www.ozgrid.com/VBA/ExcelsDialogBoxes.htm

'Uncomment the latter half if macro-enabled workbooks need to be an option
Const myFilter      As String = "Worksheets (*.xlsx),*.xlsx" ' ,Worksheets (*.xlsm),*.xlsm"
Dim sFileName       As String
   
    'Change current folder to be wherever this file is stored
   ChDir ThisWorkbook.Path
   
    'Show the open dialog and pass the selected file name to the String variable "sFileName"
   sFileName = Application.GetOpenFilename(FileFilter:=myFilter, Title:="Multi Worksheet Import", MultiSelect:=False)

    'They have cancelled.
   If sFileName = "False" Then Exit Function

    RetrieveFileName = sFileName
End Function

Brinda · Aug 11, 2014

Hi Luke, Thanks for the revised code.

But I am getting an error message stating Run-time error 13: Type mismatch in

"myCol = Right(pg2.Value, Len(pg2.Value) - 1)" under NEW Edit section.

Kindly assist

Luke M · Aug 11, 2014

Strange. What is the value in cell B26? I was under the impression that all the headers followed a format like
C##
where it's some letter and then a 1 or 2 digit number. Is this not correct?

Brinda · Aug 11, 2014

Sorry the headers are all in letters like resource name, demand name etc

Luke M · Aug 11, 2014

How will we know then where information is supposed to go? Is there a key word we can look for? Or just prompt the user and let them decide?

Brinda · Aug 11, 2014

Column named C8 (in the original report it will be named as Position Identifier) is the link between 2 parts of the reports. using C8 we have to do a vlook up and insert the remaining 15 columns between C25 and C41. does this help to revise the code

Thanks in Advance,
Brinda

Luke M · Aug 11, 2014

No...it's the C25:C41 that we need to figure out. Unless C8 is not always in col H or Part 1. Then we have 2 problems.

Brinda · Aug 11, 2014

Column C8 will be in column H in Part 1 and in Column A in Part 2 of the report

Brinda · Aug 11, 2014

can i send you the sample file how it will look like before and after

Luke M · Aug 11, 2014

If C8 is always in the same spot, that is fine. But at the beginning of today, you mentioned that instead of needing to move C31 after C30, we needed to move C26 after C25. How is the macro supposed to know where we are moving to is the question. It doesn't know whether to move to col 25, 31, 35, etc., w/o some info. That info is what we need to figure out how to define.

Brinda · Aug 11, 2014

Hmm ok

Sorry if I have confused you

Do you required further more details from my end

Luke M · Aug 11, 2014

Yes, please.
Several posts back, you were getting an error when I ammended the code because it was looking for a number in the header name, and using that to figure out where to move the data. Since then, you've told me that the header names don't actually have numbers (which is fine). But, we still need to know where to move.

So, if someone gives you a new report, how do you know where to move Part 2 to?

Brinda · Aug 11, 2014

This is a daily routine that I am doing.
Always the Part2 has to be inserted after column Y and before unmet details

PFA the sample report of how the report will look before and after.
In sheet named after I have highlighted the columns where they need to be inserted

Kindly check and let me know if i have answered your query

Luke M · Aug 11, 2014

So, it's always after col Y? And before, when we moved it to col AH, that was a mistake?

Code:

Sub MoveReport()
Dim pg2 As Range
Dim part2Report As Range
Dim destRange As Range
Dim part2Row As Long
Dim myCol As Long
Dim impPath As String
impPath = RetrieveFileName()
If impPath = "" Then Exit Sub 'User cancelled
Workbooks.Open (impPath)

'Define where part 2 is
Set pg2 = Range("A:A").Find("PAGE 2")
part2Row = pg2.Row
Set pg2 = pg2.Offset(2, 1)
Set part2Report = Range(pg2, pg2.End(xlToRight).End(xlDown))

'-------NEW EDIT----------
'New info will go after col Y
myCol = 26

Application.ScreenUpdating = False

'Insert the needed columns
Cells(1, myCol).Resize(1, part2Report.Columns.Count).EntireColumn.Insert

'Move the data
With part2Report
    .Rows(1).Cut
    ActiveSheet.Paste Destination:=Cells(15, myCol)
    Set destRange = Range(Cells(16, myCol), Cells(part2Row - 1, Cells(15, myCol).Offset(0, .Columns.Count - 1).Column))
   
    destRange.Formula = _
        "=VLOOKUP($H16," & .Offset(0, -1).Resize(, .Columns.Count + 1).Address(True, True) & ",COLUMN(B$2),FALSE)"
    destRange.Value = destRange.Value
    .Clear
End With

'Clear out old info
Range(part2Row & ":65536").EntireRow.Delete

Application.ScreenUpdating = True


End Sub

Private Function RetrieveFileName()
'obtained from:
'http://www.ozgrid.com/VBA/ExcelsDialogBoxes.htm

'Uncomment the latter half if macro-enabled workbooks need to be an option
Const myFilter      As String = "Worksheets (*.xlsx),*.xlsx" ' ,Worksheets (*.xlsm),*.xlsm"
Dim sFileName       As String
   
    'Change current folder to be wherever this file is stored
  ChDir ThisWorkbook.Path
   
    'Show the open dialog and pass the selected file name to the String variable "sFileName"
  sFileName = Application.GetOpenFilename(FileFilter:=myFilter, Title:="Multi Worksheet Import", MultiSelect:=False)

    'They have cancelled.
  If sFileName = "False" Then Exit Function

    RetrieveFileName = sFileName
End Function

Report macro

New Member

Attachments

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

New Member

Excel Ninja

New Member

New Member

Attachments

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Attachments

Excel Ninja