I have an Excel document at work with tables with rows and columns that resembles the picture I've included (not the content). I want to do two things, one of them is adding another row after a distinct value in the column as you can see in the picture, which I've done (code included). But the next step is putting the value of the column in the next row after the blank/empty row on the added row (blank) as a value as pictured with the values Small, Med, Large.
I'm not a die hard programmer but I'm learning VBA for my job and this is the code that i found on this site and works for adding a blank row:
Dim LastRow As Long
Dim i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
If i = 2 Then
'Do nothing
ElseIf Cells(i, "A") <> Cells(i - 1, "A") Then
Cells(i, "A").EntireRow.Insert
End If
Next i
Can you help me with the adding of the value of the next row?
Current and Desired output
You already loop upwards through the populated cells. Whenever you find a cell where column A had another value than the cell above, you insert a row.
Within the if block, just take the value from column B, so you get the code below.
Also, why do nothing when you arrived at row 2? Since you want to insert another empty one above, it should just be included.
End result:
Dim LastRow As Long
Dim i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
If Cells(i, "A") <> Cells(i - 1, "A") Then
Cells(i, "A").EntireRow.Insert
Cells(i, "B").Value = Cells(i + 1, "B").Value 'i + 1 would be the next row
End If
Next i
Related
I am working on a code and all I want to do is copy data from one sheet and paste it into another sheet that has a table setup.
My code is doing exactly what I want it to do but, the table doesn't resize to include all the rows that was copied, only the first row of the copied data goes into the table. and the rest are formatted as not in the table.
This is how it looks like after I run the code
Sub LastRowInOneColumn()
Dim LastRow As Longenter image description here
Dim i As Long, j As Long
'Find the last used row in a Column
With Worksheets("First Page")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'first row number where you need to paste values in Sheet1'
With Worksheets("Report")
j = .Cells(.Rows.Count, "A").End(xlUp).Row '+ 1
End With
For i = 1 To LastRow
With Worksheets("First Page")
'If .Cells(i, 1).Value = "X" Then
.Rows(i).Copy Destination:=Worksheets("Report").range("A" & j)
j = j + 1
'End If
End With
Next i
End Sub
Usually, inserting below the end of the table will make it grow automatically, but not when pasting a range that exceeds the number of columns in the table. There are two ways to deal with this:
1- limit the copied range to the number of columns in the table; i.e.
.Rows(i).Resize(,4).Copy Destination:=Worksheets("Report").range("A" & j)
' ^^^^^^^^^^^
2- Explicitly resizing the table, using the method ListObject.Resize; i.e.
With Sheet1.ListObjects(1)
.Resize .Range.Resize(.Range.Rows.count + 1)
End With
I have a dataset that includes 9 columns. I want to check each row to see if the last 3 columns are empty. If all 3 are empty, I want to delete the row. I'm currently trying to do this in VBA, but I'm a programming newb and find myself completely overwhelmed.
The pseudocode that I've written is as follows:
For Row i
If(Col 1 & Col 2 & Col 3) = blank
Then delete Row i
Move on to next Row
I'd go like follows
Dim iArea As Long
With Range("E:G") '<--| change "E:G" to your actual last three columns indexes
If WorksheetFunction.CountBlank(.Cells) < 3 Then Exit Sub
With .SpecialCells(xlCellTypeBlanks)
For iArea = .Areas.Count To 1 Step -1
If .Areas(iArea).Count Mod 3 = 0 Then .Areas(iArea).EntireRow.Delete
Next
End With
End With
Assuming you have at least one row that is always filled out, you can use the following:
Dim LR as Long
Dim i as Integer
LR = Cells(Sheets("REF").Rows.Count,1).End(xlUp).Row
For i = 1 to 9
If Range(Cells(LR-3,i),(Cells(LR,i)).Value="" Then
Columns(i).Delete
Else:
End If
Next i
This works by defining the last row as LR, and defining a variable as i. You will check column "i" to determine if the last 3 rows of the column are "", aka it's blank; one might try to use ISBLANK(), but that cannot work for an array. If this is true, then you will delete the column, i. The code will then move to the next i. The FOR LOOP using i starts at 1 and goes to 9, which corresponds to starting at column 1 (A) and ending at column 9 (I).
Edit:
I appear to have misread which was supposed to be empty and which is supposed to be deleted, in terms of columns/rows... this code would be re-written as:
Dim LR as Long
Dim i as Integer
LR = Cells(Sheets("REF").Rows.Count,1).End(xlUp).Row
For i = LR to 2 Step -1 'Assumes you have headers in Row1
If AND(ISBLANK(Cells(i,7)),ISBLANK(Cells(i,8)),ISBLANK(Cells(i,9)) Then
Rows(i).Delete
End If
Next i
Significant changes are checking is each of the 3 last columns in the row are empty, ISBLANK(), changing that a row gets deleted if the condition is met, and changing what to loop through.
Here's another answer, assuming your last three column starts on "G","H","I".
Sub DeleteRowWithLastThreeColumnsBlank()
Dim N As Long, i As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
If Cells(i, "G").Value = "" And Cells(i, "H").Value = "" And Cells(i, "I").Value = "" Then
Rows(i).EntireRow.Delete
N = Cells(Rows.Count, "A").End(xlUp).Row
End If
Next i
End Sub
I've found a couple threads with similar titles but weren't really what I am looking to do. What I'm trying to do is go through the list of numbers in Col A, and calculate the time difference using NetworkDays for the first instance the number appears in Col B ' Received On ' and the last instance the number appears in Col C ' Processed On '. After the NetworkDays calculation is done I'd like to put that value repeating in Col D on every respective row. The number of times a value will appear in Col A constantly varies, and Col A itself is several thousand lines long and constantly growing. Once that is done I need to loop through all the other different sets of numbers in Col A and repeat the process. As an example, ***39430 first appears on Row 2 and last appears on Row 7. Using Networkdays(B2,C7) gives 11 days, and so forth. After that move onto ***39383. Sample below.
Sample data
Below is the code I have so far. From the sample above I have to put a blank row under ***39430 in order to get the code to work, otherwise it just continues on to the bottom of the list and calculates that difference (not what I want obviously). What I'm stumped on is how to tell the loop to restart whenever the value changes in Col A and then continue on. I suspect it might be something close to Do Until ActiveCell.Value <> Activecell.Offset(-1,0).Value but I can't quite figure it out. Also how to get the Networkdays value to repeat on every respective row.
Dim counter As Integer
Dim CycleTime As Long
counter = 0
Do Until ActiveCell.Value = ""
counter = counter + 1
ActiveCell.Offset(1, 0).Select
Loop
'Gives the number of rows to offset
MsgBox counter
'Shows the correct number of days difference
MsgBox WorksheetFunction.NetworkDays(Range("B2"), Range("B2").Offset(counter - 1, 1))
CycleTime = WorksheetFunction.NetworkDays(Range("B2"), Range("B2").Offset(counter - 1, 1))
Range("D2").Value = CycleTime
Any help would be greatly appreciated. Thanks in advance.
Update
After using the code provided for a couple of weeks I've noticed a complication that I had not thought of before. Previously, I had thought that there was always only one output doc for each input doc (not considered in scope of original question), however as shown in Sample-New image in the top box there can be more than one output doc per input doc. For the new screenshot below I've included two additional columns, Col. C 'Output Doc #' and Col. D 'Output Doc Created On'. What I'd like to be able to do, amending the code that #YowE3K provided below, is to nest another loop that goes through Col. D 'Output Doc #' and uses NetworkDays to calculate the difference from B1 and D1 for the first group, and then B1 and D8 for the second group. As it is now, the code isn't written to handle the change and calculates everything as shown in Column F, with the ideal code resulting in Column G. The second box (in dark blue) shows a typical example where the code performs perfectly. Loops are something I'm struggling with to understand and not really sure how to even take a stab at this. Any comments to the code in a response would be very helpful. Thanks in advance.
Sample - New
The following code loops using endRow as the loop "counter".
startRow is set to the row containing the start of the current "Doc Number", and endRow is incremented until it is pointing at the last row for that "Doc Number".
Once endRow is pointing at the correct place, CycleTime is calculated and written to column D of each row from startRow to endRow. startRow is then set to point to the beginning of the next "Doc Number".
The loop ends when a blank cell is found in column A.
Sub Calc()
Dim startRow As Long
Dim endRow As Long
Dim CycleTime As Long
startRow = 2
endRow = 2
Do
If Cells(startRow, "A").Value <> Cells(endRow + 1, "A").Value Then
CycleTime = WorksheetFunction.NetworkDays(Cells(startRow, "B"), Cells(endRow, "C"))
Range(Cells(startRow, "D"), Cells(endRow, "D")).Value = CycleTime
startRow = endRow + 1
End If
endRow = endRow + 1
If Cells(endRow, "A").Value = "" Then
Exit Do
End If
Loop
End Sub
Edited to keep track of the first and last "Approved" record, and only update column D if one is found:
Sub Calc()
Dim startRow As Long 'Start of the Doc Number
Dim firstRow As Long 'First "approved" row
Dim lastRow As Long 'Last "approved" row
Dim endRow As Long 'End of the Doc Number
Dim CycleTime As Long
startRow = 2
endRow = 2
firstRow = -1
lastRow = -1
Do
If Cells(endRow, "Q").Value = "Approved" Then
'Found an "Approved" record
'Set the first row if not already set
If firstRow = -1 Then
firstRow = endRow
End If
'Set the last row (will replace this if we find another record)
lastRow = endRow
End If
If Cells(startRow, "A").Value <> Cells(endRow + 1, "A").Value Then
If firstRow > 0 Then ' (If it is -1 then we never found an "Approved" record)
CycleTime = WorksheetFunction.NetworkDays(Cells(firstRow, "B"), Cells(lastRow, "C"))
Range(Cells(startRow, "D"), Cells(endRow, "D")).Value = CycleTime
End If
'Set up for next Doc Number
startRow = endRow + 1
firstRow = -1
lastRow = -1
End If
'Go to next row
endRow = endRow + 1
'Exit when we hit a blank Doc Number
If Cells(currentRow, "A").Value = "" Then
Exit Do
End If
Loop
End Sub
I am trying to create a spreadsheet whereby I have a value in a cell in a worksheet called "Equipment" cell C5, for example a Value of 4.
Starting Cell Image
I need to use this value to copy a section of the same row (D5:M5) and paste it that many times into a worksheet called "Programming" also if this changes I would like it to delete or add where required, ignoring where there is a blank or 0 value in the "equipment" sheet
Desired Result
I have around 30 different items and all will have different sections to copy but they will be of the same size. Also Could this look down a list of values all in the same column and do the same for all the values
I'm very new to VBA and have managed to hide and show tabs based on values but i'm struggling to get my head around this as it's a little too complicated at this point.
Thank You in advance
Lee
This is what I have so far, I have edited the code to what I believe is correct but it still isn't working
Sub copySheetCells()
'loop by each cell in column "C"
For i = 2 To Sheets("Equipment").Cells(Rows.Count, "C").End(xlUp).Row
'repeat copy x times (based on cell in column "C" value)
For j = 0 To (Sheets("Equipment").Cells(i, "C").Value - 1)
'define source range
Source = "D" & (i) & ":M" & (i)
'find last row on second sheet
lastRowS2 = Sheets("Hardware_Programming").Cells(Rows.Count, "A").End(xlUp).Row
'copy data
Sheets("Equipment").Range(Source).copy Destination:=Sheets("Hardware_Programming").Range("A" & lastRowS2 + 1)
Next j
Next i
'copy headers
Sheets("Equipment").Range("D1:M1").copy Destination:=Sheets ("Hardware_Programming").Range("A1:J1")
End Sub
I only get blank spaces, is anyone able to advise any further?
Here you go, use this macro. Based on names Programming and Equipment as originally requested.
Sub copySheetCells()
'loop by each cell in column "C"
For i = 2 To Sheets("Programming").Cells(Rows.Count, "C").End(xlUp).Row
'repeat copy x times (based on cell in column "C" value)
For j = 0 To (Sheets("Programming").Cells(i, "C").Value - 1)
'define source range
Source = "D" & (i) & ":M" & (i)
'find last row on second sheet
lastRowS2 = Sheets("Equipment").Cells(Rows.Count, "A").End(xlUp).Row
'copy data
Sheets("Programming").Range(Source).copy Destination:=Sheets("Equipment").Range("A" & lastRowS2 + 1)
Next j
Next i
'copy headers
Sheets("Programming").Range("D1:M1").copy Destination:=Sheets("Equipment").Range("A1:J1")
End Sub
EDIT
Please avoid copying the code from the answer and posting it back at your question, I replaced the Sheet1 with Programming so you can rename that sheet in your workbook.
Macro seems to do what it does, the quantity in Sheet1/Programming was not provided (column "C" according to your initial requirements):
Source (with added quantity)
Result:
Hope this will solve your problem :)
For i = 1 To 30 Step 1
If Sheets("Equipment").Cells(1 + 4, 3).Value > 0 Then
Sheet1.Range(Cells(i + 3, 5), Cells(i + 3, 13)).Copy
For j = 1 To Sheet1.Cells(1 + 4, 3).Value Step 1
LR = Sheets("Programming").Cells(Sheets("Programming").Rows.Count, "A").End(xlUp).Row
Sheets("Programming").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues
Next
End If
Next
Cheers ;)
I am struggling with something that should be fairly straightforward, however, I have read at least 15 methods of doing this and cannot seem to get it to work.
Here is a sample dataset:
9:30:01 584.7
9:30:01 590
9:30:01 595
9:30:02 584.51
9:30:03 584.62
9:30:04 584.44
9:30:05 584.05
I only want one row per second, so of the first 3 rows, only one needs to stay. I don't care if it is the first or the last, but the code I have been using keeps the last, 595 in this case.
The way I am doing it is with a for loop that clears the contents of the row that has the same time as the row below it. I then sort the entire range.
I imagine there is a simpler way to simply delete the extra row from the get go. However, when I use delete on the range, instead of clear, it won't remove all of the duplicate rows.
Here is what I want the data to look like:
9:30:01 595
9:30:02 584.51
9:30:03 584.62
9:30:04 584.44
9:30:05 584.05
I need this to happen for the entire sheet. The time is Column B and the values are column C.
Here is the code I am using,
LastRow = ActiveSheet.UsedRange.row - 1 + _
ActiveSheet.UsedRange.Rows.Count
For RowNum = 2 To LastRow
If (Range("B" & RowNum) = Range("B" & RowNum + 1)) Then
Range("B" & RowNum).EntireRow.Clear
End If
Next RowNum
Range("A2:C" & LastRow).Sort key1:=Range("B2:B" & LastRow), _
order1:=xlAscending, Header:=xlNo
Don't loop. Use RemoveDuplicates. Way faster than any loop. One line of code.
Sub test()
ActiveSheet.Range("B:C").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Edit: screenshots
BEFORE
AFTER
Edit: Does not work in Excel 2011 for Mac (go figure).
This should do the trick:
Sub jzz()
Dim i As Long
For i = 1 To Cells.SpecialCells(xlLastCell).Row 'loop from row 1 to last row
If Cells(i, 1) <> vbNullString Then 'check if something is in the cell
If Cells(i, 1) = Cells(i + 1, 1) Then 'check if cell is the same as next cell
Cells(i + 1, 1).EntireRow.Delete 'if so; delete
i = i - 1 'go back one row
End If
End If
Next i
End Sub
Another option is to go from the bottom up, like so:
Sub jzz()
Dim i As Long
For i = Cells.SpecialCells(xlLastCell).Row to 1 step -1'loop from last row to row 1
If Cells(i, 1) <> vbNullString Then 'check if something is in the cell
If Cells(i, 1) = Cells(i + 1, 1) Then 'check if cell is the same as next cell
Cells(i + 1, 1).EntireRow.Delete 'if so; delete
End If
End If
Next i
End Sub
what you prefer to use if personal. Please consider the answer of teylyn as well, in this situation, it is very usable.