I am trying to list the comparisons of each two cells in the same column. Say, I have some values in the cells A1,A2,A3,..,A11. I'm trying to create a table such that in each cell contains the minimum value of two Ai and Aj (i is not equal to j). i.e min(Ai,Aj)=x. However, I managed to write something that helps me to compare A1 with other Ai's. In each time, I need to change what I wrote so as to get the comparison of A2 to other cells (except A1). How can I manage to get the list once? Thanks in advance.
This is what happens when I run my code.
This is I am trying to get.
Sub comparisonfunction2()
Dim ds As Long ' number of files
Dim i As Long 'loop variable
Range("A1").Select
ds = 12
yp = Sheets("Sheet1").Range("a1").CurrentRegion.EntireRow.Count
For i = 2 To ds
If Cells(2, 1) < Cells(i + 1, 1) Then
Cells(2, 1).Select
Selection.Copy
Cells(i + 1, 5).Select
ActiveSheet.Paste
Else
Cells(i + 1, 1).Select
Selection.Copy
Cells(i + 1, 5).Select
ActiveSheet.Paste
End If
Next
End Sub
Just type =MIN($A$2,A3), drag the formula
Related
I am trying to move cell values in columns K to L down within its column to the same row as every blank cell in column E.
Hopefully this makes sense but I think i need to figure out how to find each blank cell's row number and force it as a row variable i can then use to tell my code to move cell values in range K13:L. For example, if there's a value in K13:L14 and the blank cells in column E is E20 and E23, i want K13 and L13 to move to K20 and L20 while K14 and L14 move to K23 and L23.
The number of blank cells will always match however many cells with value are in column K/L
Would appreciate any help on this!
Use the macro below to start your studies. But first you need to remove the values in column K&L to N&O. (Maybe you can record a macro and add the recorded codes to the start of the codes below.)
Sub move_it()
i = 13
j = 13
Do While Cells(j, 14).Value <> ""
If Cells(i, 5) <> "" Then
i = i + 1
Else
Range("n" & j, "o" & j).Select
Selection.Cut
Range("K" & i).Select
ActiveSheet.Paste
j = j + 1
i = i + 1
End If
Loop
End Sub
The answer that was i needed to offset my copy paste by the rows i needed to move it to!
ws.Range("E" & openitemstartrow + 1, ws.Range("F" & openitemstartrow +
10).End(xlUp)).Copy
targetws.Range("G" & rows.Count, "H" & rows.Count).End(xlUp).Offset(1, 4).PasteSpecial Paste:=xlPasteValues
I have been trying to make a macro which copies some values from some cells to others. I have some code which gets the next line in the table, and then it copies the cell values and pastes them into the table. This works for only half of the cells I wish to copy however. It copy and pastes the values from cells B4 and B5 but not F5 and F7 (see below)
Sub YesTrade()
Dim lastRow As Long
Dim currentDate As String
currentDate = Date
lastRow = Worksheets("Trades").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Trades").Cells(lastRow + 1, 1).Value = Date
Worksheets("Calculator").Range("B4").Copy Worksheets("Trades").Cells(lastRow + 1, 2)
Worksheets("Calculator").Range("B5").Copy Worksheets("Trades").Cells(lastRow + 1, 3)
Worksheets("Calculator").Range("F5").Copy Worksheets("Trades").Cells(lastRow + 1, 4)
Worksheets("Calculator").Range("F7").Copy Worksheets("Trades").Cells(lastRow + 1, 5)
End Sub
Why not using simple .Value property of Range object?
Worksheets("Trades").Cells(lastRow + 1, 2).Value = Worksheets("Calculator").Range("B4").Value
Worksheets("Trades").Cells(lastRow + 1, 3).Value = Worksheets("Calculator").Range("B5").Value
Worksheets("Trades").Cells(lastRow + 1, 4).Value = Worksheets("Calculator").Range("F5").Value
Worksheets("Trades").Cells(lastRow + 1, 5).Value = Worksheets("Calculator").Range("F7").Value
I recommend using PasteSpecial or Destination. Here's one example with PasteSpecial which copy and pastes only values:
'Copy values
Worksheets("Calculator").Range("F5").Copy
'Paste Values with PasteSpecial
Worksheets("Trades").Cells(lastRow + 1, 4).PasteSpecial Paste:=xlPasteValues
Example with Destination:
'Copy values
Worksheets("Calculator").Range("F5").Copy Destination:=Worksheets("Trades").Cells(lastRow + 1, 4)
Hopefully this helps with your problem. If it doesn't, please provide more information about values in your cells.
I guess your issue is you're copying/pasting some formulas that would yield zero in destination sheet
you might then follow Michał Turczyn's suggestion (use Value property) and shorten your code with the use of With ...End With syntax
Sub YesTrade()
Worksheets("Trades").Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = Date
With Worksheets("Calculator")
Worksheets("Trades").Cells(Rows.Count, 1).End(xlUp).Offset(, 1).Resize(, 4).Value = Array(.Range("B4"), .Range("B5"), .Range("F5"), .Range("F7"))
End With
End Sub
or, in a (possibly) more readable way:
Sub YesTrade()
Worksheets("Trades").Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = Date
With Worksheets("Calculator")
Worksheets("Trades").Cells(Rows.Count, 1).End(xlUp).Offset(, 1).Resize(, 4).Value = Array(.Range("B4"), _
.Range("B5"), _
.Range("F5"), _
.Range("F7"))
End With
End Sub
I have an excel worksheet with a lot of data that needs pruning.
Data is a organized by ID number with multiple rows attached to a given ID. For each unique ID, I need to to keep all rows with certain codes (which are found in column B). I also need to keep the rows immediately above the rows with the "keeper codes," provided such a row exists. If no such row exists, then I need to insert a blank row.*
For a given ID, if no "keeper code" is present, then all rows associated with the ID should be deleted. All rows not associated with a "keeper code" or immediately above a row with a "keeper code" should be deleted.
Probably best explained by screenshot. Data will be sorted by ID number as pictured.
*Inserting a blank row would be nice but if it makes the coding difficult then is not very necessary.
Thanks much!
Try this out,
Sub copyRows()
Dim i As Long, j As Long
Sheets.Add.Name = "newSheet"
Rows(1).Copy Sheets("newSheet").Cells(1, 1)
j = Sheets("newSheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If InStr(Cells(i, 2), "Keep") > 0 And Cells(i, 1) = Cells(i - 1, 1) Then
Rows(i - 1).Copy Sheets("newSheet").Cells(j, 1)
Rows(i).Copy Sheets("newSheet").Cells(j + 1, 1)
ElseIf InStr(Cells(i, 2), "Keep") > 0 Then
Rows(i).Copy Sheets("newSheet").Cells(j, 1)
End If
j = Sheets("newSheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
Next i
End Sub
If inserting empty rows is necessary you may have to work on that logic.
This macro creates a new sheet with the output.
I have a macro that inserts 2 columns on my current sheet and pastes information from another sheet.
I want to create 2 variables that are assigned to each column that would change the next time I run the macro to paste the information in the next two columns.
Columns("BO:BO").Select
Selection.Insert Shift:=xlToRight
Range("BO2").Select
ActiveCell.FormulaR1C1 = "Feb weekly-wk 2"
Range("BO19").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range("BO19").Select
Selection.AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Range("BO19:BO47").Select
Columns("BP:BP").Select
Selection.Insert Shift:=xlToRight
Range("BP2").Select
Selection.Style = "20% - Accent6"
Range("BP2").Select
ActiveCell.FormulaR1C1 = "Diff"
Range("BP19").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
My idea is to set up a variable that I would replace my current "BO" and "BP" code with.
Dim X as String, Y as String
X = "BO"
y = "BP"
When I run the macro it would change the variable for this example "BO" to "BQ" and "BP" to "BR". Next time I run the macro would change the "BQ" to "BS" and "BR" to "BT".
I just cleaned your code a little:
Dim ColBO As Integer
Dim ColBP As Integer
Dim StrBO As String
Dim StrBP As String
StrBO = "BO"
StrBP = "BP"
ColBO = ActiveWorkbook.Range(StrBO & 1).Column 'instead of StrBO you could directly write ("BO" & 1)
ColBP = ActiveWorkbook.Range(StrBP & 1).Column 'Then you wouldnt need these two variables
Columns(ColBO).Insert Shift:=xlToRight
'Columns(ColBO).Select ' Trying to avoid selection but not sure if this works here...
'Selection.Insert Shift:=xlToRight
Range(1, ColBO).FormulaR1C1 = "Feb weekly-wk 2"
Range(19, ColBO).FormulaR1C1 = "=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range(19, ColBO).AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Columns(ColBP).Insert Shift:=xlToRight 'Same here as above
Range(2, ColBP).Style = "20% - Accent6"
Range(2, ColBP).FormulaR1C1 = "Diff"
Range(19, ColBP).FormulaR1C1 = "=RC[-2]-RC[-1]"
For the future: If you can, try to avoid .Select/Selection/.Activate if possible. The code can mostly run without such commands and without activating a cell. ;)
If you are not actually writing BO/BP to the range you are transforming I would go with two ints, stored in a hidden sheet. Read/write each time you run the macro.
This is, in my opinion, the easier solution, other places to go would be global variables or storing it to a file.
If you want to use numeric variables you can change approach and use Cells instead of Range:
'You can use the rows below to know the column number
Range("BO1").Activate
ActiveCell.Value = ActiveCell.Column 'This way you get the column number into the cell
ColNum = ActiveCell.Column 'This way you get the column number into the variable
'So now you know that BO column number is 67 and you can use
Cells(1, 67) = "OK"
'Or, using variables:
RowNum = 1
ColNum = 67
Cells(RowNum, ColNum) = "You Got It!"
This makes you able to loop columns simply using a for ... next
If you need to loop from BO to BR you can use
For ColNum = 67 To 70
Cells(1, ColNum) = "OK"
Next ColNum
Hope it helps.
Dim x As Integer
Dim y As Integer
For y = 3 To 3
For x = 600 To 1 Step -1
If Cells(x, y).Value = "CD COUNT" Then
Cells(x, y).EntireRow.Select
Selection.EntireRow.Hidden = True
End if
If Cells(x, y).Value = "CD Sector Average" Then
Cells(x, y).EntireRow.Select
Selection.Insert Shift:=xlDown
Cells(x + 1, y - 1).Select
ActiveCell.FormulaR1C1 = "=R[0]C[1]"
Cells(x + 1, y + 1).Select
Selection.ClearContents
Cells(x + 1, y + 2).Select
Selection.ClearContents
Cells(x + 1, y + 3).Select
Selection.ClearContents
Cells(x + 1, y + 4).Select
ActiveCell.FormulaR1C1 = ***"=sum(R[This is what I need to change]C:R[-3]C"***
Cells(x + 2, y).Select
End If
I need to make the starred formula come out as a sum of a column that ends 3 rows above the Sector average row and starts the number that is displayed in a cell in the Count Row.
I tried this to no avail in the count if statement
Dim count As Integer
count = Cells(x , y).Value
And then using the count variable in the cell reference and got an error.
Any tips would help or if I'm going about this wrong let me know.
You have to find a suitable formula for entering in the target cell. Then you would build such formula with string concatenation, etc., for entering it via VBA.
One option for the formula is to use OFFSET, as in
=SUM(OFFSET($A$1,D3-1,COLUMN()-1):OFFSET($A$1,ROW()-3-1,COLUMN()-1))
This sums all values from Cell1 to Cell2, in the same column you place the formula. Cell1: at the row indicated by the value in D3, Cell2: 3 rows above the cell that contains the formula.
Another option is to use INDIRECT, as in
=SUM(INDIRECT("C"&D3):INDIRECT("C"&(ROW()-3)))
This sums all values from Cell1 to Cell2, in column C. Cell1: at the row indicated by the value in D3, Cell2: 3 rows above the cell that contains the formula.
You're already using Cells(row, col) to reference your location, so you already know exactly what row you're on. Therefore:
ActiveCell.FormulaR1C1 = "=sum(R[" & x-3 & "C:R[" & X & "]C"
will give you Row("CD Sector Average")-3 through Row("CD Sector Average"). Adjust the x-3 and x as necessary, since I'm not 100% certain which rows you need to total.
Also, now that you've used the Macro Recorder to get your basic code (a great place to start, BTW, but it will teach you terrible coding habits), go read How to avoid using Select in Excel VBA macros to learn how to clean up your code.