How can I Conditionally Insert Rows after Page Breaks in Excel VBA? - excel

I am currently attempting to write a macro that Inserts a "Title continued" and a "Subtitle continued" row at the top of each new page, when appropriate. To do this, I want to loop through every row and determine:
Is the row a page break that is not a title or subtitle (if so, a row insert "Title continued" and another row "Subtitle continued"),
Is the row a page break and already a subtitle (if so, only insert "Title continued"),
Is the row already a title or not a page break (if so, skip),
Currently for every row except the subtitles and titles themselves, the subtitle and title are stored in columns C and D respectively. For the title and subtitle rows, columns C and D are blank. The issue that I am coming across is that I am getting weird shifting after the first insert occurs. Most row inserting macros go backwards, but that won't work here because the page breaks will change after inserting rows before the break. Here is the code I have written:
Inserts = 0
Dim Counter As Long
Counter = 1
While Counter < RowCount
If Rows(Counter).PageBreak <> -4142 And Cells(Counter, "C").Value <> "" Then
Range("C" & (Counter), "C" & (Counter + 1)).EntireRow.Insert
Cells(Counter, "A").Value = UCase(Cells(Counter + 2, "D").Value) & " continued"
Cells(Counter + 1, "A").Value = UCase(Cells(Counter + 2, "C").Value) & " continued"
Counter = Counter + 3
Inserts = Inserts + 2
ElseIf Rows(Counter).PageBreak <> -4142 And Cells(Counter + 1, "C").Value <> "" Then
Range("C" & Counter).EntireRow.Insert
Cells(Counter, "A").Value = UCase(Cells(Counter + 2, "D").Value) & " continued"
Counter = Counter + 2
Inserts = Inserts + 1
Else: Counter = Counter + 1
End If
Wend
RowCount = RowCount + Inserts - 2
Thanks!
Andy

Update: This code actually does work as intended. The issue was that other columns in the spreadsheet were affecting the page breaks even though they were out of the print range. I deleted those columns in the code after this segment was run, so the page breaks shifted afterwards, giving the impression that this portion didn't work. Setting all automatic page breaks to xlPageBreakManual solved the issue without forcing me to delete the columns early (as I needed their data).

Related

Cell not populating

I have two cells that are refusing to populate in row 10 and 70. Every other cell populates and I have tried changing columns, even workbooks but I still get the same problem. There is no protection or passwords. I have no idea of the cause. This is the very simple code it is running on these cells:
i = 1
Worksheets("Output").Range("N1") = i
For z = 2 To lastrow - 1
If Worksheets("Output").Range("D" & z).Value < Worksheets("Output").Range("D" & z - 1).Value Then
i = i + 1
Worksheets("Output").Range("N" & z).Value = i
End If
If Worksheets("Output").Range("D" & z).Value = Worksheets("Output").Range("D" & z - 1).Value Then
Worksheets("Output").Range("N" & z).Value = i & " (tie)"
Worksheets("Output").Range("N" & z - 1).Value = i & " (tie)"
End If
If Worksheets("Output").Range("D" & z).Value = "" Then
i = i + 1
Worksheets("Output").Range("N" & z).Value = i
End If
Next z
I cannot fathom out why it is happening, the trouble is it messes up my sequence. I have tried forcing it to populate if it is blank with those last 3 lines but still nothing.
The principle error in your code is that it contains a logical trap:-
If [Condition 1] Then i = i + 1
If [Condition 2] Then i = i + 1
This is contrary to the logic that every row defined by z needs a result. The trap is in that nothing will be counted if neither of the two conditions are met. Therefore you should structure your code as follows.
If [Condition 1] Then
i = i + 1
ElseIf [Condition 2] Then
i = i + 1
Else
i = i - 1
End If
In this way, using Else, it will be impossible to skip a row.
However, there are more logical flaws in your code. and once I set out to determine what might be in column D I came to a totally different structure which I share with you below.
Sub STO_66111404()
Dim i As Long ' rank
Dim Tie As Boolean ' next item is of same value
Dim Tied As Boolean ' last item was of same value
Dim R As Long ' loop counter: rows
With Worksheets("Output")
For R = 1 To .Cells(.Rows.Count, "D").End(xlUp).Row - 1
i = i + Abs(Not Tie) ' Abs(Not Tie) = 1 if Tie is False
' Val() converts any non-numeric value, incl "", to 0
Tied = Tie
Tie = Val(.Cells(R, "D").Value) = Val(.Cells(R + 1, "D").Value)
.Cells(R, "N").Value = i & IIf(Tie Or Tied, " (tie)", "")
Next R
.Cells(R, "N").Value = i + Abs(Not Tie) & IIf(Tie, " (tie)", "")
End With
End Sub
It may take you a moment to recognize this code as your own. So, here are a few points to guide you.
With Worksheets("Output") helps you avoid repeating the sheet name over and over again. In the code that follows this line, and until End With, the object is represented merely by a leading period. .Cells(.Rows.Count, "D") stands for Worksheets("Output").Cells(Worksheets("Output").Rows.Count, "D")
Ranges comprising of single cells are most efficiently addressed by the syntax designed for that purpose, to wit, by a cell's coordinates instead of its range name. So, .Cells(R, "D") stands for Range("D" & R). This syntax has the added advantage that it is also equal to .Cells(R, 4), meaning you can easily calculate both row and column numbers.
The big difference in the approach is that your code focuses on the conditions and therefore uses a lot of IFs. In the above approach the focus is on the results of the conditions, expressed in the two variables, Tie and Tied. Your code has no equivalent for the latter but doesn't seem to need it, either. Note, however, that the above code may not handle the case correctly where the next value in column D is smaller than the preceding. The code just checks for equality and presumes that the next value is bigger if it isn't equal, setting Tie = False here: Tie = Val(.Cells(R, "D").Value) = Val(.Cells(R + 1, "D").Value). In your approach, this may be the reason for the skipped lines.

Copy values based on match criteria

Data Sheet
I have two workbooks with the same content. I am copying and pasting the amount values from one workbook sheet to another when the project number and division is the same. The amount has to be pasted in the row where there is a match. The issue I am facing is all the amounts are getting copied but not pasted near the respective match.
The code I have used is as follows:
ws1PRNum = "E" 'Project Number
ws1Div = "I" 'Division
ws2PRNum = "E" 'Project Number
ws2Div = "I" 'Division
'Setting first and last row for the columns in both sheets
ws1PRRow = 5 'The row we want to start processing first
ws1EndRow = wsSrc.UsedRange.Rows(wsSrc.UsedRange.Rows.count).Row
ws2PRRow = 5 'The row we want to start search first
ws2EndRow = wsDest.UsedRange.Rows(wsDest.UsedRange.Rows.count).Row
For i = ws1PRRow To ws1EndRow 'first and last row
searchKey = wsSrc.Range(ws1PRNum & i) & wsSrc.Range(ws1Div & i) 'PR line and number is Master Backlog
'if we have a non blank search term then iterate through possible matches
If (searchKey <> "") Then
For j = ws2PRRow To ws2EndRow 'first and last row
foundKey = wsDest.Range(ws2PRNum & j) & wsDest.Range(ws2Div & j) 'PR line and number in PR Report
'Copy result if there is a match between PR number and line in both sheets
If (searchKey = foundKey) Then
'Copying data where the rows match
wsDest.Range("AJ5", "AU1200").Value = wsSrc.Range("AJ5", "AU1200").Value
wsDest.Range("BB5", "BM1200").Value = wsSrc.Range("BB5", "BM1200").Value
wsDest.Range("BT5", "BU1200").Value = wsSrc.Range("BT5", "BU1200").Value
Exit For
End If
Next
End If
Next
This is the area that is causing an issue. As seen in the picture the amounts are pasted even in rows where the division and project number are empty. Any answer for the same would be highly appreciated as I am not well versed with VBA.
You can do this:
wsDest.Range("AJ" & j, "AU" & j).Value = wsSrc.Range("AJ" & i, "AU" & i).Value
'etc...
or with a bit less concatenation:
wsDest.Rows(j).Range("AJ1:AU1").Value = wsSrc.Rows(i).Range("AJ1:AU1").Value

Loop through listbox rows if column is not empty copy paste to empty row in sheet

I'm trying to loop through listbox(attached picture below), and if the column(3) has value, then copy & paste row to empty row in excel sheet for later use.
I wanted to copy the row using column value to put it in sheet, but it just copys last row value, and repeats.
Could you please point out what I did wrong in the below code?
TIA
s = 22
For i = 0 To Me.AnBox.ListCount - 1
If Me.AnBox.Column(3) <> "" Then
Sheets("SparePartsRequestForm").Range("A" & s).Value = Me.AnBox.Column(2)
Sheets("SparePartsRequestForm").Range("C" & s).Value = Me.AnBox.Column(1)
Sheets("SparePartsRequestForm").Range("D" & s).Value = Me.AnBox.Column(3)
s = s + 1
End If
Next i
Userform
Part of excel sheet
Few errors:
The index of your ListBox.Column is zero based, so you not looking at the third but second Index.
You are accessing the values wrongly, trying to read a full column so it seems. The correct syntax is expression.Column(pvargColumn, pvargIndex) so you are missing a parameter. Check the documentation remarks to see the difference between using the second parameter or not.
Make use of the iteration and the more common List property to access each row individually.
So therefor your code could look like:
s = 22
For i = 0 To Me.AnBox.ListCount - 1
If Me.AnBox.List(i, 2) <> "" Then
Sheets("SparePartsRequestForm").Range("A" & s).Value = Me.AnBox.List(i, 1)
Sheets("SparePartsRequestForm").Range("C" & s).Value = Me.AnBox.List(i, 0)
Sheets("SparePartsRequestForm").Range("D" & s).Value = Me.AnBox.List(i, 2)
s = s + 1
End If
Next i
It is possible through the Column property too though:
s = 22
For i = 0 To Me.AnBox.ListCount - 1
If Me.AnBox.Column(2, i) <> "" Then
Sheets("SparePartsRequestForm").Range("A" & s).Value = Me.AnBox.Column(1, i)
Sheets("SparePartsRequestForm").Range("C" & s).Value = Me.AnBox.Column(0, i)
Sheets("SparePartsRequestForm").Range("D" & s).Value = Me.AnBox.Column(2, i)
s = s + 1
End If
Next i
Note: If your intention is to paste at the next available row, there are great ways to return the last used row of a range. See here for example

Excel VBA: Paste formula in While loop

I have developed the following While loop and want not only add the data but also insert a formula into the mix. The formula is added but does not increment by row. See R4. I could write a separate While loop or For to loop but wanted to keep in the current loop
While Not project.EOF
i = i + 1
For ii = 1 To project.Fields.count
shtDetail.Cells(i, ii).Value = project.Fields(ii - 1).Value
Cells(i, "T").Formula = _
"=IFERROR(INDEX(data!B:B,MATCH(R4,data!A:A,0)),0)"
Next
project.MoveNext
Wend
EDIT your indenting is a bit off so my answer was not great: more like this:
While Not project.EOF
i = i + 1
For ii = 1 To project.Fields.count
shtDetail.Cells(i, ii).Value = project.Fields(ii - 1).Value
Next ii
shtDetail.Cells(i, "T").Formula = _
"=IFERROR(INDEX(data!B:B,MATCH(R" & i & ",data!A:A,0)),0)"
project.MoveNext
Wend
I'm not following your comments about adding quotes - adding them to what?

Delete Excel record when value ends with plus sign ('+')

We have a blank workbook which I would like the user to be able to paste a list of reference numbers into column A. Some of these reference numbers will have a "+" at the end.
Sub texter1()
With Sheets("texter")
ll = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To ll
If InStr(1, .Range("a" & i).Value, "+", 1) Then
.Range("b" & i).Formula = "=LEFT(A" & i & ", LEN(A" & i & ")-1)"
.Range("c" & i).Value = Sheets("texter").Range("b" & i).Value
.Range("d" & i).Formula = "=VLOOKUP($c" & i & ", _
[Current_Master.xlsm]Master!$A$3:$BB$20000,14,FALSE)"
.Range("e" & i).Formula = "=VLOOKUP($c" & i & ", _
[Current_Master.xlsm]Master!$A$3:$BB$20000,15,FALSE)"
Else
Cells(i, "a").EntireRow.Delete
End If
Next i
End With
End Sub
I would like reference numbers without the "+" to have the whole row deleted. Reference numbers with a "+" work fine.
this seems to work but has to be run multiple times for it to delete all the rows without a "+" and I cannot figure out why. Please help
Thank you
You cannot delete a row inside a loop as far as affects the iterations. Imagine this: you have 4 rows; the second row meets the conditions and is deleted; in the next iteration the counter is 3 but the row number 3 is now the fourth row (when you delete a row, all the ones below go up one position); consequently, row number 3 wouldn't be analysed. Thus the solution is simple:
Cells(i, "a").EntireRow.Clear()
If you want to actually delete the whole row, you would have to do it outside the main loop. For example: store all the rows to be deleted in an array and iterate through this array right after completing the main loop.
Another alternative would be performing the iterations in the main loop in inverse order (from maximum row to minimum one), although this option is not always applicable (not sure if in your case) and might provoke further problems. The two options above are good enough, I have mentioned this last alternative just as something worthy to be known.
--- UPDATE
To delete the rows after the main loop you can use something on these lines:
'Declaration of variables
ReDim allRows(ll + 1) As Long
Dim allRowsCount As Long: allRowsCount = 0
In your main loop you store the given rows (where you have now Cells(i, "a").EntireRow.Delete):
For i = 1 To ll
'etc.
else
allRowsCount = allRowsCount + 1
allRows(allRowsCount) = i
After the loop is completed, you go through all the stored rows (in inverse order) and delete them:
If (allRowsCount > 0) Then
Dim curRow As Long: curRow = allRowsCount + 1
Do
curRow = curRow - 1
.Rows(allRows(curRow)).Delete
Loop While (curRow > 1)
End If
End With
End Sub

Resources