I'm back with another question that probably has a simple answer. I really fall down when it comes to loops, so this is what I am trying to build.
I am building a form where user will type in a number between 1 and 156 (named range "GenNo") and click a Generate button.
I need a loop that will copy a template built in the "Template" tab of the spreadsheet with the named range also being "Template", and then insert it into the main form page the specified amount of times. This way the rest of the content and other named ranges should be pushed down accordingly.
Probably a very simple answer but I am terrible when it comes to loops and would not know where to start.
Thanks for your help.
EDIT: This attempt only generates one template in the form:
Sub Generate()
' Check if payslips are already generated
If Sheets("Data").Range("GenLogic").Value = 1 Then
MsgBox ("Already Generated! Please clear the form and regenerate.")
Else
Sheets("Data").Range("GenLogic").Value = 1
End If
' Loop code
Do Until Sheets("Data").Range("LoopLogic").Value = Range("GenNo").Value
Sheets("Template").Range("Template").Copy
Sheets("Overpayment Form").Range("Start").Insert
Range("LoopLogic") = Cell.Value + 1
Loop
End Sub
i would give this a shot; note that i removed your updating of your loop variables. Also, i've rewritten your loop to use a for, and shift down on insert.
Sub Generate()
' Check if payslips are already generated
If Sheets("Data").Range("GenLogic").Value = 1 Then
MsgBox ("Already Generated! Please clear the form and regenerate.")
Else
Sheets("Data").Range("GenLogic").Value = 1
End If
' Loop code
Dim iFrom As Long, iTo As Long, i As Long
iFrom = Sheets("Data").Range("LoopLogic").Value
iTo = Range("GenNo").Value
For i = iFrom To iTo
Sheets("Template").Range("Template").Copy
Sheets("Overpayment Form").Range("Start").Insert Shift:=xlDown
Next
End Sub
Related
the code is intended to seek out the "Yes" in "OverExtensions" and will create a new range and determine the maximum value of the new range. For some reason the logic of the code seems alright but I'm getting an empty result and would love the community's input as to where I've went wrong.
Private Sub CommandButton1_Click()
Dim maximum As Double, OverExtension As Range, x As Range
Cells.Interior.ColorIndex = 0
Set OverExtension = Range("D2:D12")
maximum = WorksheetFunction.Max(Range("c2:c12"))
For Each x In OverExtension
If x.Value = Yes Then
If x.Offset(0, -1).Value = maximum Then
x.Cells.Interior.ColorIndex = 22
End If
End If
Next x
End Sub
You nested the if and for blocks in a wrong way.
You have to put the second End If between Next PriceNo and Next OEResult.
Update:
You need just one End If. The first one is wrong because If and Then are in one line.
Besides you have problem with your OEYes and OEResult variables as they are defined but not initialized but as I don't know your intention I also don't know how to solve it.
Kind of new to VBA programming but need it to complete a project.
I'm basically trying to copy and paste cells based on an IF Statement and would like to do this on a cell-by-cell basis so I incorporated a loop. The code looks like the following below. What ends up happening is that the first line is copied/pasted just fine but the loop does not continue. When I use debug.print i , the only number that is populated is 6. I've also tried a For Statement but that ends up behaving the same way. Any ideas?
Private sub Copy_Dates()
Dim i as Integer
i =6
Do
If Cells(i,79)= 1 then
Sheets("Tracking").Select
Range(Cells(i,106),Cells(i,108)).Copy
Sheets("Tr_Tracking").Select
Range(Cells(i_25003,2),cells(i+25003,4)).PasteSpecial Paste:=xlPasteValues
End if
i= i+1
Loop while i < 10
End sub
EDIT:
So I've realized that the code that i wanted is not going to be very helpful to my project anymore. What I really need is a method to select non consecutive cells based on a criteria, and then copy those cells to another worksheet as a single block.
So, taking from the above code, I need to make sure to select
.range(.cells(i,106,.cells(i,108))
only when the following condition is met:
if .cells(i,79)=1
then imagine that i would have some array of selected cells based on this condition and then i would be able to paste it to the second sheet defined above wsO=thisworkbook.sheets("TR_Tracking").
I hope that makes sense and hopefully not too complicated of logic.
EDIT:EDIT:
I was able to figure this one out. I used the following code below to accomplish the edit section above.
Private Sub SelectArray_andCopy()
Dim FinalSelection as Range
Sheets("Tracking").Select
Cells(2,79).Select
For each c in intersect(activesheet.usedrange,range("CA6:CA500"))
if c.value=1 then
if finalselection is nothing then
set finalselection=range(cells(c.row,106),cells(c.row,108))
else
set finalselection = union(finalselection, range(cells(c.row,106,cells(c.row,108)))
end if
end if
next c
if not finalselection is nothing then finalselection.select
Selection.copy
Sheets("TR_Tracking").Select
Range("b250009,d26000").PasteSpecial Paste:=xlPasteValues
The problem is that you are using .Select and hence the focus is changing. Also your cells objects are not fully qualified.
INTERESTING READ
Further i_25003 is incorrect. I guess you meant i + 25003
Try this (UNTESTED)
Private Sub Copy_Dates()
Dim wsI As Worksheet, wsO As Worksheet
Dim i As Long
Set wsI = ThisWorkbook.Sheets("Tracking")
Set wsO = ThisWorkbook.Sheets("Tr_Tracking")
For i = 6 To 9
With wsI
If .Cells(i, 79) = 1 Then
wsO.Range(wsO.Cells(i + 25003, 2), wsO.Cells(i + 25003, 4)).Value = _
.Range(.Cells(i, 106), .Cells(i, 108)).Value
End If
End With
Next i
End Sub
I am trying to build quite a complex excel macro based on dynamic data. My first stumbling block is that i am struggling to get a button-triggered Excel macro to take name of each tab after the current one and insert its name every third column of the current sheet
I have:
Sub Macro1()
On Error Resume Next
For Each s In ActiveWorkbook.Worksheets
Sheet2.Range("A1:ZZ1").Value = s.Name
Next s
End Sub
This really does not work well, as it simply seems to enter the name of the last sheet all the way between A1 and ZZ1! what am I doing wrong?
This will put the names of worksheets in the tabs to the right of the Activesheet in every 3rd column of row 1 of the Activeshseet:
Sub Macro1()
Dim i As Long
With ThisWorkbook
'exit if Activesheet is the last tab
If .ActiveSheet.Index + 1 > .Worksheets.Count Then
Exit Sub
End If
For i = .ActiveSheet.Index + 1 To .Worksheets.Count
.ActiveSheet.Cells(1, (i - .ActiveSheet.Index) + (((i - .ActiveSheet.Index) - 1) * 2)) = .Worksheets(i).Name
Next i
End With
End Sub
Please note that it's a bad idea to useOn Error Resume Next in the general manner that you did in your original code. It can mistakenly mask other errors that you don't expect. It should just be used to catch errors that you do expect.
I have a table that takes user input data and fills in the rest of the table from the data. So far I have created a macro that automatically fills in the table from the users data.
I want to have the user input the amount of times they want to run the macro (as each table displays a days worth of input) but every time the macro runs it just fills in the same space and doesn't display multiple days worth of tables.
Not knowing your macro, let's assume you have a generic macro that stores user input in a column:
Sub InputMacro()
Range("B1:B100").Value = InputBox("What do you want to store in column B")
End Sub
If you want to loop over this, you first need to parameterize the macro, i.e. make the part flexible that you want to change it in each loop step. E.g. if you want to run over multiple columns, you could do this:
Sub InputMacro_new(intColNumber As Integer, Optional lngRowNumber As Long = 100)
Cells(1, intColNumber).Resize(lngRowNumber) = _
InputBox("What do you want to store in column " & _
Split(Cells(1, intColNumber).Address, "$")(1))
End Sub
This will now accept a parameter intColNumber, i.e. you can call InputMacro_New 2 to fill column B. Note that I also provided an optional parameter lngRowNumberthat by default is 100. You do not need to provided this parameter - but if you want you can override the default, e.g. InputMacro_New 2, 50)
Now you can create a loop in another macro that calls your macro:
Sub MyLoop()
Dim intCol As Integer, varMaxCols As Variant
varMaxCols = InputBox("How many columns do you want to fill?")
If Not IsNumber(varMaxCols) Then Exit Sub
ElseIf varMaxCols < 1 Or varMaxCols > 255 Then Exit Sub
For intCol = 1 To varMaxCols
InputMacro_new intCol
Next intCol
End Sub
Of course, if you want you can also combine both into one larger macro - but esp. for larger macros it is best practice to split it into smaller procedures.
I want to iterate over all rows of a MS-Word mail merge data source and extract the relevant data into an XML.
I'm currently using this code:
Imports Microsoft.Office.Interop
Do
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
If DataSource.ActiveRecord = LastRecord Then
Exit Do
Else
DataSource.ActiveRecord = Word.WdMailMergeActiveRecord.wdNextDataSourceRecord
End If
Loop
And it turns out to be a little sluggish (About 1 second for each row). Is there any way to do it faster?
My fantasy is finding a function like MailMergeDataSource.ToDatatable and then inspecting the datatable.
Any time you're iterating through something row by row, and then doing some kind of processing on each row, is going to get a little slow.
I would be inclined to approach this problem by having a step before this which prepared the mdictMergeFields collection so that it only contained elements that were not 'null or empty', this will mean you won't have to check for that on each iteration. You could do this in process, or 'sneakily' in the background while the user is doing something else.
The other thing to try (might help!) is to change the "Do... Loop" block so that you're not checking at the end of each imported row whether or the record is the 'last record'. Instead, get a count of the records, and then compare the current index to the knowm maximum (which might be quicker)
I.E.:
Dim i, x as Integer
i = ActiveDocument.MailMerge.DataSource.RecordCount
Do While x < i
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
x += 1
Loop
I don't really work with the Office Interop much, but hopefully this might offer some assistance! Post back, let me know how it goes.
/Richard.