I would like to know how to write a Macro to copy the value of L3 up to L2 based on the fact that A2 and A3 are equal and B2 and B3 are also equal. Where subsequent rows of columns A and B are not equal the macro does not need to push data up. In some instances there may be as many as 10 subsequent rows where A & B column vales are equal and the oldest month value would need to roll right up to the top row where A & B match.
The entire sheet has about 150 rows with many City and Company values. I am currently performing this operation manually and it is time consuming. The purpose of the spreadsheet is to provide a sales visit summary based on data that is extracted out of our SQL based CRM package. Row 4 has no meaningful data is that context but it does not hurt if the data is rolled up Row 2 as long as all months with visits are represented on the top row where columns A & B match.
I'm guessing that the macro needs to loop through JAN (Column E) and complete that column and then loop through columns G through P sequentially after that. Only Columns E through P need to be manipulated. I don't think it will have any negative consequences if the data is concatenated in the cells or just overwritten. Once the Macro is complete the top row for a given Company at a certain site should contain values in all of the months where it was visited.
My programming knowledge is limited but I can usually reverse engineer code enough to modify it if I get a good sample. I hope my request is clear.
Based on your first initial question "how to copy L3 to L2 if B2=B3 and A2=A3", this basic macro will get you started along those lines:
Option Explicit
Sub CopyUP()
Dim LR As Long, Rw As Long, col As Long
LR = Range("A" & Rows.Count).End(xlUp).Row 'last row with data
For Rw = LR To 2 Step -1 'from the bottom up, compare
If Range("A" & Rw) = Range("A" & Rw - 1) And _
Range("B" & Rw) = Range("B" & Rw - 1) Then
For col = 5 To 16 'columns E:P
If Cells(Rw, col) <> "" Then Cells(Rw - 1, col) = Cells(Rw, col)
Next col
End If
Next Rw
End Sub
Related
This involves two last rows so please bear with me, last rows will be different every time.
I have a large dataset and need to copy formulas from the last row of columns L through AC down to the last row of whatever that happens to be in column A (which Column A last row will always be greater than L). Think of it Columns on the left (A-K) update and columns on right dont update and are left behind so i need to bring columns on right down (these are formulas in these columns).
Columns A-K last row is 18500
Columns L-AC last row is 18450
So i need to "fill" or copy row L18450:Ac18450 down to L18500:AC18500
Currently I have
dim LLastrow as long
dime ALastrow as long
LLastrow = Range ("L" & rows.count).end(xlup).row
ALastrow = Range ("A" & rows.count).end(xlup).row
Range("L" & LLastrow : "AC" & LLastrow).Select
but this give me an ERROR
The next step would look like
Selection.copy
Range("L" & ALastrow).pastespecial
I am trying to build code to do the following:
In a workbook I have two sheets.
Sheet 2 has several columns, I want to create a loop to read each row in a particular column, lets say column D. When the row in that column is not equal to zero, I want to copy the value in that row to a column in Sheet2, Lets say its Column G in sheet 2 but it would be the same row from column D in sheet 1.
Example
Sheet 2 Sheet 1
Column D Column G
0 Don’t copy from Sheet 2
500 500 (Copied from Sheet 2)
20 20 (Copied from Sheet 2)
I was able to figure this out using an example from another post as well as looking at Felipe's suggestion.
I was using a function to find the last row in one of my sheets within a workbook as I was coping data. By using this lastrow function I created a loop and was able to use an IF statement that allowed me to copy the row that had data to a column(s) in my other sheet
FirstRow = Range("A2").Value
'Find the last non-blank cell in column A(1)
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim b As Integer, Buy As Integer
For b = 2 To LastRow
If Range("F" & b).Value <> 0 Then
Range("F" & b).Select
Selection.Copy
Sheets("T-1 BSR").Select
Range("I" & b).Select
ActiveSheet.Paste
Range("J" & b).Select
ActiveSheet.Paste
Sheets("BAML Futures PnL").Select
End If
Next b
I also used the same logic as I had to use another column and multiply it by -1 when there was a sell
Dim s As Integer, Sell As Integer
For s = 2 To LastRow
If Range("G" & s).Value <> 0 Then
Sell = Range("G" & s) * -1
Range("G" & s).Value = Sell
Range("G" & s).Select
Selection.Copy
Sheets("T-1 BSR").Select
Range("I" & s).Select
ActiveSheet.Paste
Range("J" & s).Select
ActiveSheet.Paste
Sheets("BAML Futures PnL").Select
End If
Next s
Not sure if this was the most efficient way but it does work
I would go to create dynamic ranges & declare them in my VBA code.
So, after creating a dynamic range (using the Name Manager to define dynamic ranges using OFFSET), which is explained in here: Create Dynamic Range (Offset), ...
... I would declare them at the beginning of my code. To declare a range using a the Name Manager, look here Excel Named Ranges.
... then name the column within the range, in order to assign a value to it. The following link leads to the Column property in Range.Columns.
... then, create your loop using Range_1 in Range_2 (Column): Loop through Defined Range.
... Finally, just compare the values using an If (If Statement), retrieving the position of the cell when it's successful (Range.Column & Range.Row) & copying it to the second sheet (Range.Value).
I am building a web scraping tool that obtains particular data. Once the data has been extracted the next step is to summarize it into a report thus i need some guidance on the final part of the project.
I have a column (Column A) that contains the following data set
Description of product
$3000
Description of product
$5000
etc
I would like to find a value (in this case the common value is $) and cut this value next to the description (into Column B). There could be hundreds of rows thus a loop would be required.
My initial thought is to use code that will find a value ($), then once the value is found, cut the row and using an offset paste the value (into column B)
Any help would be appreciated
sub test()
dim usedrows,i as integer
usedrows = activesheet.range("A" & activesheet.rows.count).end(xlup).row
for i=0 to usedrows
if instr(range("A" & i+1),"$") <> 0 then
'Checks if the looped cell has "$" sign
range("B" & i+1)=range("A" & i+1)
range("A" & i+1)=""
end if
next
end sub
Copy ColumnA into ColumB. Delete B1 with Shift cells up. Series fil1 a column with 1 in odd rows, 2 in even, then filter to select the 2s delete those rows and then the column of 1s.
This site already has something similar: Copy and insert rows based off of values in a column
but the code doesn't take me quite where I need to go, and I haven't been able to tweak it to make it work for me.
My user has a worksheet with 4 columns, A-D. Column A contains specific contract numbers, column B is blank, column C has part numbers, and column D has the entire range of contract numbers. My user wants to count the number of times the entire range contract numbers has duplicates so I entered the formula =countif($D$2:$D$100000,A2) in cell E2 and copied down, giving me the number of times the specific contract in column A appears in column D. The numbers range from 1 to 11 in this workbook but the number may be higher in other workbooks this method will be used in.
The next thing I need to do is to enter blank cells below all values in column E that are greater than 1, very much like the example in the previously asked question. I then also need to copy in the same row and insert copied cells exactly to match in the same row in column A. Example: Cell E21 has the number 5 so I need to shift cells in column E only so that there are 4 blanks cells directly below it. In column A, I need to copy cell A21 and insert copied cells in four rows directly below.
Just trying to get the blank cells to insert has been a trial, using the code as given in the previous question.
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet
Set lo = sh.ListObjects("Count")
Set rColumn = lo.ListColumns("Count").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).Cells.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
I would be very grateful for any help as I have been fighting with this monster for a week.
While this is indeed possible to do, it might be a good idea to look into moving the list of all contract numbers from column D to a different sheet. Even though it is quite simple to loop through a range and insert rows based on cell values - it'll also create holes in columns D and E.
Here's code for simply adding the rows and copying the values as you specified.
Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("E" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
source.Range("A" & i + 1) = val 'Set value
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub
Of course you could also remove the holes from column D after inserting the new rows and modify the formula in column E so that it remains copyable and doesn't calculate for the copied rows.
Generally it makes things easier if a single row can be thought of as a single object, as creating or deleting a row only affects that one single object. Here we have one row represent both a specific contract and a contract in the all contracts list - this could end up causing trouble later on (or it could be totally fine!)
I've been looking for it everywhere but I can't seem to find the answer although it seems an regular problem.
I'm trying to automate the duplication of cells in excel.
I have two lists: list 1 with values 1,2,3,4 and the second list is with values a,b,c,d.
Now I want to have a file where for every value in list 1, the values in list two are duplicated in excel. So:
1 - a
1 - b
1 - c
1 - d
2 - a
2 - b
2 - c
2 - d
3 - a
...
I'm wondering if there's a function within excel or if not a macro that I could use to solve this? For this short list it is of course easy to do with autofill, but when the list consists of a few hundred values, it gets more complicated...
You can do this also with a few formulas/support columns without VBA:
Let's assume your first category is in column A, starting in A2 and your category is in column B.
Determine the record count for each category, e.g. in C1: =COUNTA($A:$A)-1 (assuming a header row) and C2 equivalent
Place two support column, e.g. in E and F) - E will hold the row for the first category and F the Id for the second category. Place the following formula in E2: =IF(ISTEXT(E1),1,IF(F2=1,E1+1,E1)) and this in F2: =IF(ISTEXT(F1),1,IF(F1=$C$2,1,F1+1))
Add two more columns for the final result - G for category one with formula =INDEX(A:A,E2+1) and H for category 2 with the formula =INDEX(B:B,F2+1).
Now simply copy the formulas for the columns E:H down for a many rows as required (number of rows required is =C1*C2
In the end it'll look something like this:
You can download the file here.
This should be really easy to understand ...
Open VBE ALT+F11 and right click VBA project. Insert a Module and copy-paste the below code. Hit F5 to run
Sub Main()
Dim number As Range
Dim letter As Range
For Each number In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each letter In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
With Sheet2
.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1) = number
.Range("B" & .Range("b" & Rows.Count).End(xlUp).Row + 1) = letter
End With
Next
Next
End Sub
The above code assumes that your sheet1 looks like this
and the results will be on Sheet2 like this