I am looking for a solution for the following example. I have a client who sends me a spreadsheet with 321 columns of random length. In row 2, they have a store number. For each column, there is a different store number. I need to insert a blank column in between each column and then copy the store number in the new column the same length of number of cells.
I use the following to add the columns:
Sub InsertColumns()
Dim J As Integer, k As Integer
J = Range("A1").End(xlToRight).Column
'j is the last column
For k = J To 2 Step -1
Range(Cells(1, k), Cells(1, k)).EntireColumn.Insert
Next k
I just need the code for count up base on the data in the previous column, copying the value from the previous store and pasting this in the column based on the number of rows of the previous column.
Thanks!
Joe
Sub tgr()
Dim cIndex As Long
For cIndex = Cells(2, Columns.Count).End(xlToLeft).Column To 2 Step -1
Columns(cIndex + 1).Insert
Range(Cells(1, cIndex + 1), Cells(Rows.Count, cIndex).End(xlUp).Offset(, 1)).Value = Cells(2, cIndex).Value
Next cIndex
End Sub
Try adding the following just below your posted code block:
Range(Cells(2, 1), Cells(2, (J * 2))).Copy
Range("B2").Select
ActiveSheet.PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, IconFileName:=False
Basically it copies the second row up to the point where you have data (previous counted columns times 2 to account for the added blanks), selects the first blank cell, then does a Paste Special with the "Skip Blanks" attribute turned on.
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'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
So I'm trying to make a sample selector.
The current variables I have are a range that has been specified by the user.
Settings.AmountColumn is a range that looks something along the lines of B1:H100.
SampleRefArr is an array of row numbers, relative to the first row of the Settings.AmountColumn.
For example, if my SampleRefArr shows (3,4,7) then I will need to take the following ranges (B4:H4,B5:H5,B8:H8) and copy them to a new spreadsheet. I have built the following code but that does not select the right cells...
counter = UBound(SampleRefArr, 1)
For i = 1 To counter
rowSelector = SampleRefArr(i) - Settings.AmountColumn.Cells(1, 1).Row + 2
'Settings.AmountColumn.Cells(rowSelector, 1).EntireRow.Select
Settings.AmountColumn(Cells(rowSelector, 1), Cells(rowSelector, 10)).Select
Next i
you could use this:
Sub RangeSelector(rng As Range, refArr As Variant)
Intersect(rng, rng.Range("A" & Replace(Join(refArr, ","), ",", ",A")).EntireRow.Offset(1)).Select
End Sub
to be called like:
RangeSelector Range("B1:H100"), Array(3, 4, 7)
which would return cells "B4:H5" and "B8:H8" selected
Perhaps this?
counter = UBound(SampleRefArr, 1)
For i = LBound(samplrefarr,1) To counter
With Settings.AmountColumn
rowSelector = SampleRefArr(i) - .Cells(1, 1).Row + 2
'Settings.AmountColumn.Cells(rowSelector, 1).EntireRow.Select
.Range(.Cells(rowSelector, 1), .Cells(rowSelector, 10)).Select
End With
Next i
I'm trying to use this logic:
Range(Selection, Selection.End(xlUp)).Select
In a loop string. Right now the data is create by the loop, so I'm attempting to select the row above, and all the rows for the table for that column, and add the SUM to the cell below.
I'm using a loop as the table can change depending on the reference, and when the data is received I add a new table. Everything works good up to when I want to sum a column in the table and add it below. The cell always returns a 0.
At this point
i = 6
j = 13
ws2.Cells(i , j ).Value = Application.Sum _
(Range(Cells(i, j - 1), Cells(i, j - 1).End(xlUp)))
Thanks for any advice!
Here is a technique using WorksheetFunction.Sum to create a running total.
Sub AddRunningTotal()
Const FIRST_ROW = 2
Const SOURCE_COLUMN = 11
With Worksheets("Sheet2")
With .Range(.Cells(2, SOURCE_COLUMN), .Cells(.Rows.Count, SOURCE_COLUMN).End(xlUp))
.Offset(0, 1).FormulaR1C1 = "=SUM(R2C[-1]:RC[-1])"
'Uncomment to replace the formulas with their values
'.Value = Value
End With
End With
End Sub
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