I have VBA code to insert a user-defined number of blank rows, and it works well. What I need to add to the code is a way to insert formulas in the first blank rows after they have been inserted. Specifically, I need to add the values in the last row of data in columns J+T, K+U, L+V, M+W, N+T, O+U, P+W, Q+U, R+W, and S+V into each blank row inserted.
If it helps, the VBA code for inserting the blank rows is below:
Dim NumRowsToInsert, FirstRow As Long
Dim RowIncrement As Long
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim LastEvenlyDivisibleRow
Dim i As Long
Do
FirstRow = InputBox("Please indicate at which row you want to start.")
Loop Until IsNumeric(FirstRow)
NumRowsToInsert = InputBox("How many rows would you like to insert _
between each row of data?")
Do
Loop Until IsNumeric(NumRowsToInsert)
RowIncrement = InputBox("How many rows of data between line inserts?")
Do
Loop Until IsNumeric(RowIncrement)
Set ws = ActiveSheet
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastEvenlyDivisibleRow = Int(LastRow / RowIncrement) * RowIncrement
If LastEvenlyDivisibleRow = 0 Then
Exit Sub
End If
Application.ScreenUpdating = False
For i = LastEvenlyDivisibleRow To FirstRow Step -RowIncrement
.Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown
Next i
End With
Application.ScreenUpdating = True
End Sub
Any help is greatly appreciated!
To add a formula to a cell you would do something to this effect
'this makes the value of Row 20 Column 1 the sum of B2 through B10
Sheets(1).Cells(20, 1).Formula = "=Sum(B2:B10)"
Related
I am quite new to VBA so my question may sound silly to some of you.
I have a problem with my code. I am trying to check between 2 sheets(1st: test and 2nd: test data. In the code I am using the code name of the sheets) how may times a criteria/my product is met and based on that number to add that many rows beneath the SKU/product.
What I want to do is, if for my first product/SKU I have stock in 5 different locations, I want to add 5 rows in the first sheet and to see the qty in column D and the location in column E.
TestData tab
The reason why I need to list the quantity in different cells is that the stock is in different locations, so I can not just add in to one cell.
I am also adding screen shots of how my two sheets look like.
I have not add the loop to find the location yet, but I want to understand how to add the rows first.
Sub test()
Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range
lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)
For Each cell In myrange
For i = 1 To lastrow
If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
result.Cells(i, 1) = testrange.Cells(i, 2)
End If
Next i
Next cell
End Sub
Here is the raw structure you were asking for.
Sub test()
' 011
Dim Rng As Range
Dim Tmp As Variant
Dim Radd As Long ' number of rows to add
Dim R As Long ' row counter
With Tdata
' Range, Cells and Rows Count, all in the same sheet
' exclude caption row(s)
Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False ' speed up the process
With TestTab
' end the loop in row 2 because row 1 might contain captions
' loop bottom to top because row numbers will change
' below the current row as you insert rwos
' column 1 = "A"
For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
Tmp = .Cells(R, 1).Value
Radd = Application.CountIf(Rng, Tmp)
If Radd > 1 Then
.Range(.Rows(R + 1), .Rows(R + Radd)).Insert
.Cells(R + 1, 1).Value = Radd ' for testing purposes
End If
Next R
End With
Application.ScreenUpdating = True ' now you look
End Sub
As our Evil Blue Monkey has suggested, inserting blank rows and then populating them may not be the most efficient way. You can copy a row and then click Insert to insert the copied data into a new row. Get the syntax from the Macro recorder if it's of interest. It works with the Range object the same way.
I am trying to loop through all rows (there is 1000's of rows) in column 'AQ' and if value = "Salary Sacrifice" then I want to display "SALSC" in column 'AP' same row. Here is my code I have so far:
Dim payCodeDescription As String
Dim paycodevalue As String
payCodeDescription = Range("AQ52").Value
If payCodeDescription = "Salary Sacrifice" Then paycodevalue = "SALSC"
ElseIf payCodeDescription = "GrossPay-Overpaid" Then paycodevalue = "OVERP"
End If
Range("AP52").Value = paycodevalue
Is there any way I could turn this into a loop instead of hard coding?
I would use this if formuala...
=IF(AQ52="Salary Sacrifice","SALSC",IF(AQ52="GrossPay-Overpaid","OVERP",""))
but this replaces the values if the condition is false and I need it to do nothing if the value is false.
Any help would be greatly appreciated.
If you are still looking to use VBA, something like the code below will help:
Sub LoopThroughRows()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
LastRow = ws.Cells(ws.Rows.Count, "AQ").End(xlUp).Row
'get the last row with data on Column AQ
For i = 2 To LastRow
'loop from row 2 to the Last row
If ws.Cells(i, "AQ").Value = "Salary Sacrifice" Then ws.Cells(i, "AP").Value = "SALSC"
If ws.Cells(i, "AQ").Value = "GrossPay-Overpaid" Then ws.Cells(i, "AP").Value = "OVERP"
'process your conditional statements
Next i
'next row
End Sub
The faster method as mentioned in the comments would be Filtering the data instead of looping through individual rows, the code below is an example of that:
Sub FilterRows()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet4")
'declare and set the worksheet you are working with, amend as required
ws.Cells.AutoFilter
If ws.FilterMode = True Then ws.AutoFilter.ShowAllData
'apply Autofilter and make sure we show all data
LastRow = ws.Cells(ws.Rows.Count, "AQ").End(xlUp).Row
'get the last row with data on Column AQ
ws.Range("$A$1:$AQ$" & LastRow).AutoFilter Field:=43, Criteria1:="Salary Sacrifice"
'filter by Criteria on Column 43, AQ
ws.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Value = "SALSC"
'fill visible rows in Column AP with the desired text
ws.Range("$A$1:$AQ$" & LastRow).AutoFilter Field:=43, Criteria1:="GrossPay-Overpaid"
ws.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Value = "OVERP"
If ws.FilterMode = True Then ws.AutoFilter.ShowAllData
'clear the Filter to show all data again.
End Sub
In the above example, I'd like to start in F2, and copy F2,G2 and H2, then paste those values in a new row.I'd like to continue to do that until the last column at the end of the row.I would also be ok if I started in C2 and had to paste in a new sheet. I'd like to continue doing this until the last row is empty.
I've found this, but it only copies every 3rd cell, not a range:
Sub CopyNthData()
Dim i As Long, icount As Long
Dim ilastrow As Long
Dim wsFrom As Worksheet, wsTo As Worksheet
Set wsFrom = Sheets("Sheet2")
Set wsTo = Sheets("Sheet1")
ilastrow = wsFrom.Range("B100000").End(xlUp).Row
icount = 1
For i = 1 To ilastrow Step 3
wsTo.Range("B" & icount) = wsFrom.Range("B" & i)
icount = icount + 1
Next i
End Sub
I assume the best way to do this is through VBA, but I'm a bit of a novice in VBA. Any suggestions would be appreciated.
If I understand your comment correctly, you just want to copy a larger range?
You can do that similar to:
stepCt = 3
lr = stepCt-1
For i = 1 To ilastrow Step stepCt
With wsTo
.Range(.Cells(icount,2),.Cells(icount+lr,2)) = wsFrom.Range(wsFrom.Cells(i,2),wsFrom.Cells(i+lr,2))
End With
icount = icount + stepCt 'Accounts for multiple ROWS
Next i
Can do similar to multiple columns, where instead of adding lr (last row) to the row argument of Cells() you can add to the column argument of Cells(). The use of stepCt wouldn't be necessary in that case.
Edit1:
Changing to show columns, not rows, as the original question changed from asking for copying F2, F3, & F4 to F2, G2, & H2.
For i = 1 To ilastrow
With wsTo
.Range(.Cells(icount,6),.Cells(icount,8)).Value = wsFrom.Range(wsFrom.Cells(i,6),wsFrom.Cells(i,8)).Value
End With
icount = icount + 1
Next i
I'm not sure this is what you are looking for, but this will paste all data in a range starting from F2 into a new sheet starting in C2.
Sub CopyNthData1()
Dim Source As Range
Set Source = Worksheets("Sheet1").Range(("F2"), Range("F2").End(xlDown).End(xlToRight))
Source.Copy
Dim DestRange As Range
Set DestRange = Worksheets("Sheet2").Range("C2")
DestRange.PasteSpecial xlPasteAll
End Sub
Hello and first let me say thank you!
I use Excel to capture user requirements and descriptions. I then take that information and clean it up and paste into presentation docs, apply formatting, paste into Powerpoint, etc. It can be 100s of lines in total that this is done for. What I'm looking for is a macro that I can apply to data once it is pasted into Excel. The data will be text, non-numeric
I have a macro that I use to insert a blank row as every other row. I then do everything else manually (macro shown below).
What I'm looking for is a macro that inserts a blank row, then offsets Column 2 by 1 row down. then pastes column 1 into column 2(without copying the blank cells over my already existing data in column 2).
I've pasted a link to an image of what I'm looking for. I've also tried to show below (numbers are column 1, letters are column 2).
2 columns to 1 column - desired result
1 A 2 B3 C
Result I want:
1
A
2
B
3
C
My current "Blank Row" Macro:
Sub insertrow()
' insertrow Macro
Application.ScreenUpdating = True
Dim count As Integer
Dim X As Integer
For count = 1 To 300
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(0, 0)).EntireRow.Insert
ActiveCell.Offset(1, 0).Select
For X = 1 To 1
Next X
Else
ActiveCell.Offset(1, 0).Range("a1").Select
End If
Next count
End Sub
This should work, but you'll have to adjust a little for your exact layout and needs.
Sub mergeColumns()
Dim mergedData As Variant
ReDim mergedData(1 To 600)
dataToProcess = Range("A2:B301")
For i = 1 To 300
mergedData(i * 2 - 1) = dataToProcess(i, 1)
mergedData(i * 2) = dataToProcess(i, 2)
Next i
Range("B2:B601") = WorksheetFunction.Transpose(mergedData)
End Sub
The following does what you need without inserting blank rows. It also calculates what the last row is on the sheet that has 2 columns so that you don't need to hard-code when the loop will end.
The comments should help you understand what is happening each step of the way. You can then modify this to work with your particular workbook. There are a lot of ways you could go about this. I chose to put the pivoted result on a second sheet.
Sub PivotTwoColumnsIntoOne()
Dim wb As Workbook
Dim src As Worksheet
Dim tgt As Worksheet
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
Dim targetRow As Long
Set wb = ThisWorkbook
' set our source worksheet
Set src = wb.Sheets("Sheet1")
' set our target sheet (where the single column will be)
Set tgt = wb.Sheets("Sheet2")
' get the last row on our target sheet
lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
' set the starting point for our target sheet
targetRow = 1
Set rng = src.Range("A1:A" & lastRow)
For Each cell In rng
With tgt.Range("A" & targetRow)
' get the value from the first column
.Value = cell.Value
' get the value from the second column
.Offset(1).Value = cell.Offset(, 1).Value
.HorizontalAlignment = xlLeft
End With
targetRow = targetRow + 2
Next cell
End Sub
I have a rather silly problem. I have a macro (linked to a button) which copies cells A1:A2 from one worksheet (namedFP) to another worksheet (Log). I intend to copy these 2 cells on the log sheet every time I hit the macro button. The problem I am facing right now is that when I use the button multiple times, these cells are getting copied over each other instead of using the next available row to paste the cells.
This is what I have now, and I tried changing the 'Rowcount+1' to 'RowCount+2' but that did not work. Any help is appreciated.
DHRSheet.Select
Range("A1:A2").Select
Selection.Copy
LogSheet.Select
RowCount = LogSheet.UsedRange.Rows.Count
Dim r As Integer
r = RowCount + 1
Dim infocell As Range
Set infocell = Cells(r, 1)
infocell.Select
ActiveSheet.Paste
infocell.Value = DHRSheet.Name & "$" & infocell.Value
DHRSheet.Select
ActiveWorkbook.Save
Is this what you are trying?
Sub Sample()
Dim LogSheet As Worksheet, DHRSheet As Worksheet
Dim lrow As Long
'~~> Change this as applicable
Set LogSheet = Sheets("Sheet1")
Set DHRSheet = Sheets("Sheet2")
With LogSheet
lrow = LogSheet.Range("A" & .Rows.Count).End(xlUp).Row + 1
DHRSheet.Range("A1:A2").Copy .Range("A" & lrow)
End With
End Sub
Here's a function I use that is very reliable and always returns the last row of a sheet without fail:
(possibly excessive for your simple use, but I always recommend it)
Public Function LastRowOfSheet(ByVal TestSheetNumber As Variant)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Input: Sheet index # or Sheet name
' Output: Last row of sheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim intNumberOfRowsInWorksheet As Long
intNumberOfRowsInWorksheet = Sheets(TestSheetNumber).UsedRange.Rows.Count
intNumberOfRowsInWorksheet = intNumberOfRowsInWorksheet + Sheets(TestSheetNumber).UsedRange.Row - 1
LastRowOfSheet = intNumberOfRowsInWorksheet
End Function
And I'd clean up your above code and use something like this:
Sub Move2RowsToEnd()
Dim iNextRowOfOutput As Long
Dim iRowNumber As Long
'- use the function to find the last row of the output sheet. we'll be pasting to the first row after.
iNextRowOfOutput = (LastRowOfSheet("Log") + 1)
'- you can adjust this for loop to loop through additional cells if you need to paste more than 2 rows in the future.
For iRowNumber = 1 To 2
'- for each row of input (2 total) set the value of the output sheet equal to it.
Sheets("Log").Range("A" & iNextRowOfOutput).Value = Sheets("namedFP").Range("A" & iRowNumber).Value
iNextRowOfOutput = iNextRowOfOutput + 1
Next iRowNumber
'- not sure which of these you want to save (one or both)
Sheets("namedFP").Save
Sheets("Log").Save
End Sub
Just paste the function above or below the Subroutine and let me know if you have any issues or questions regarding the 'Move2RowsToEnd' code.