Excel/VBA

Advertisement


Question
Hi Tom

The number "51" is written in cell "N1" on Sheet 5.

In the range "A51:A100" there is a list of names.  The maximum number of names in the list can be 49.

Let's imagine there are 28 names in this range.

The code needs to add "1" to the number in N1 and then run this code:

Public Sub MoveMarksheet()
   Dim lHeight     As Long
   Dim lWidth      As Long
   Dim lLastPos    As Long
   Dim lFreePos    As Long
   
   Const sREPORT          As String = "rngMarksheet"
   
   Application.ScreenUpdating = False
   
   ' Get source report size
   With Range(sREPORT)
       lHeight = .Rows.Count
       lWidth = .Columns.Count
   End With
   
   ' Get last empty position to add new report
   lLastPos = wksTarget.UsedRange.Rows.Count
   lFreePos = (lLastPos \ lHeight) * lHeight + 1
   
   ' Add report
   Range(sREPORT).Copy
   With wksTarget.Cells(lFreePos, 1)
       .PasteSpecial xlValues
       .PasteSpecial xlPasteFormats
   End With
   Application.CutCopyMode = False
   
   ' Set page break
   If lLastPos > 1 Then wksTarget.HPageBreaks.Add before:=Cells(lFreePos, 1)
   Application.ScreenUpdating = True
End Sub


This process needs to be repeated 28 times (the number of names in the range).  When the process is finished the number 79 will be in cell "N1"

Is this something that can be achieved with VBA.  If so could you write it for me?  

Thanks in advance

Chris

Answer
Chris,

your procedure used   wksTarget, but never defines what sheet that is.  I added a place in the routine where you need to do that.

Also, it isn't clear what sheet needs to be active when your procedure is run.  It seems to assume a specific sheet.  

I have added a calling procedure that loops through the names  in Sheet5 in range A51:A100
Note that I used "Sheet5" and not "Sheet 5".  Change if it is actually "Sheet 5"
I have assumed that the names in A51:A100 start in A51 and are constant text values - not produced by formulas.  

I have assumed that both procedures will be in the same general/standard module.

Sub abc()

Dim r     As Range
Dim r1    As Range
Dim r2    As Range
Dim cell  As Range

With Worksheets("Sheet5")
Set r = .Range("N1")
Set r1 = .Range("A51:A100")
End With

Set r2 = r1.SpecialCells(xlConstants, xlTextValues)

For Each cell In r2
 r.Value = r.Value + 1
 MoveMarksheet
Next

End Sub

Public Sub MoveMarksheet()
  Dim lHeight     As Long
  Dim lWidth      As Long
  Dim lLastPos    As Long
  Dim lFreePos    As Long
  Dim wksTarget   As Worksheet
  
  ' wksTarget designates the output sheet
  Set wksTarget = Worksheets("Sheet1")  '<== change to the proper worksheet
  
  Const sREPORT          As String = "rngMarksheet"
  
  Application.ScreenUpdating = False
  
  ' Get source report size
  With Range(sREPORT)
      lHeight = .Rows.Count
      lWidth = .Columns.Count
  End With
  
  ' Get last empty position to add new report
  lLastPos = wksTarget.UsedRange.Rows.Count
  lFreePos = (lLastPos \ lHeight) * lHeight + 1
  
  ' Add report
  Range(sREPORT).Copy
  With wksTarget.Cells(lFreePos, 1)
      .PasteSpecial xlValues
      .PasteSpecial xlPasteFormats
  End With
  Application.CutCopyMode = False
  
  ' Set page break
  If lLastPos > 1 Then wksTarget.HPageBreaks.Add before:=Cells(lFreePos, 1)
  Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.