I am trying to replicate in VBA the simple function in excel which allows you to repeat a function through an entire column, and stops when the columns on the side are empty. Specifically, I want to repeat an if - else if function for the entire relevant part of the column
Here's an attempt which does not really work
Sub RepeatIfElseif
Range("A1").Select
If selection > 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "X"
Range("A1").Select
ElseIf selection <= 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "Y"
End If
Range("B1").Select
selection.AutoFill Destination:=Range("B1:B134")
Is there any way I can do it with a loop?
You do not need to loop to drop formulas in. You just need to know where the last row is!
Pick a column that is most likely to represent your last row (I am using Column A in my example) and then you can dynamically drop-down your equation in one line without the loop.
The below will fill in the equation A2 + 1 in Column B starting from 2nd row (assuming you have a header row) down to the last used row in Column A
Option Explicit
Sub Formula_Spill()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet!
Dim LR As Long
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row '<-- Update column!
ws.Range("B2:B" & LR).Formula = "=A2+1" '<-- Update formula!
End Sub
If you want to use a loop, you can use something like the code below:
For i = 1 To 134
If Range("A" & i).Value > 0 Then
Range("B" & i).FormulaR1C1 = "X"
Else
Range("B" & i").FormulaR1C1 = "Y"
End If
Next I
It can be done without a loop, something like:
Range("B1:B134").Formula = "=IF(A1>0," & Chr(34) & "X" & Chr(34) & "," & Chr(34) & "Y" & Chr(34) & ")"
Not sure what formula you are trying to achieve with .FormulaR1C1 = "Y" ?
I'm trying to improve my English, I swear...
I would do something like this:
dim row as long
dim last_row as Long
last_row = ActiveSheet.Range("A1048576").End(xlUp).Row
For row = 1 to last_row
If Range("A" & row).Value > 0 Then
ActiveSheet.Range("B" & row).Value = "X"
Else
ActiveSheet.Range("B" & row).Value = "Y"
End If
Next row
Hope this helps.
Related
any help with this would be appreciated.
I am trying to copy a cell from column (G) into another worksheet, if cells from the same row in column (R) = "Y" and column (B) = "Month"
I had it working for just "Y" criteria but as soon as I added the "Month" this button has stopped working?
this is the code I have;
Private Sub CommandButton1_Click()
Dim LR As Long, i As Long
With Sheets("Savings Q4")
LR = .Range("R" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With .Range("R" & i)
If .Value = "Y" Then
With .Range("B" & i)
If .Value = "January" Then
Sheets("Savings Q4").Range("G:G").Copy Destination:=Sheets("Cifas Loadings").Range("A:A")
End If
End With
Next i
End With
End Sub
Any help would be appreciated.
Thanks
Too Much 'Withing' and 'Ifing'
Rules
The number of With statements must be equal to the number of End With statements.
The number of If statements must be equal to the number of End If statements, except when there is a 'one-line' If Statement.
Insights
Alexey C's solution gets those With-s and If-s in line, but problems still remain.
When you write With .Range("R" & i) it refers to Sheets("Savings Q4") from the previous With statement and you are actually shortening the line
With Sheets("Savings Q4").Range("R" & i)
which is OK.
When you later write With .Range("B" & i) it doesn't refer to Sheets("Savings Q4"), it refers to .Range("R" & i) i.e. your not shortening the line With Sheets("Savings Q4").Range("B" & i) but
With Sheets("Savings Q4").Range("R" & i).Range("B" & i)
which is WRONG.
Matteo NNZ correctly commented that the If statements could be shortened to one If statement using the And operator.
When you write
Sheets("Savings Q4").Range("G:G").Copy_
Destination:=Sheets("Cifas Loadings").Range("A:A")
you are copying the entire G column to the entire A column. Since this is in a loop (For i = 1 to LR), each time the code 'encounters' "January" and "Yes", it copies the entire column. It is highly unlikely that you are trying to achieve that functionality.
Plan of Changes
Get rid of the 'inner' With's.
Reduce the If's using And.
Change the COLUMN ranges G:G and A:A to the corresponding CELL ranges.
Get rid of Destination:=.
The Code
Sub WithIf()
Dim LR As Long, i As Long
With Sheets("Savings Q4")
LR = .Range("R" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("R" & i).Value = "Y" And _
.Range("B" & i).Value = "January" Then
.Range("G" & i).Copy Sheets("Cifas Loadings").Range("A" & i)
End If
Next i
End With
End Sub
Remaining Issues
A further problem might be that you didn't want the A column data copied in the same row as the G column data. If this is the case you should apply the same LR = .Range("R" & Rows.Count).End(xlUp).Row logic and integrate it into the code referring to the A column of sheet "Cifas Loadings".
At least, you forgot one End With and one End If. But anyway it's not correct with logical part.
Dim LR As Long, i As Long
With Sheets("Savings Q4")
LR = .Range("R" & Rows.count).End(xlUp).Row
For i = 1 To LR
With .Range("R" & i)
If .Value = "Y" Then
With .Range("B" & i)
If .Value = "January" Then
Sheets("Savings Q4").Range("G:G").Copy Destination:=Sheets("Cifas Loadings").Range("A:A")
End If
End With
End If
End With
Next i
End With
It's easier to make it w/o With, like
if Range("R"& i).value="Y" and Range("B" & i).value = "Month"
COPE CELLS
end if
I'm having an issue with trying to expand on the code that I have written. The code I have pasted below is currently working as intended. The issue I have is that I am trying to make the "P2" cell variable. Essentially, I am trying to compare the ("K" & i) cell in the loop to all the dates in the range P2 to AA2 on my sheet. Then if the month and year matches, paste the data in the corresponding column that matched. I have tried replacing the column reference P with another integer, but could not get the nested loop to function correctly. Is there a different way to establish a column as a variable? Thank you for your help.
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
If Month(Range("K" & i)) = Month(Range("P2")) And Year(Range("K" & i)) = Year(Range("P2")) And Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Range("P" & i).PasteSpecial xlPasteValues
End If
Next i
End Sub
Just loop through the columns 16 through 27 inside your existing loop:
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
'loop columns p through aa
For k = 16 to 27
'Instead of Range() we are using Cell() to refer to the column variabl-y... Cells(<rownum>,<columnnum>)
If Month(Range("K" & i)) = Month(Cells(2,k)) And Year(Range("K" & i)) = Year(Cells(2,k)) And Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Cells(i,k).PasteSpecial xlPasteValues
End If
Next k
Next i
End Sub
I would like to write perfectly working code but am faced with this issue. I want to transfer the data as values to another sheet. To fill out the data I use a form with formulas inside cells.
Then every time I click to transfer the data to another sheet it replaces the source data with its values in both sheets, but for me need that forms cells in the sheet1 stay unchanged. I use a form with formula to put data in the sheet1 from different sources, so it should work every time then I use it (now, after each click I have to recover formulas in the sheet1).
Here is the code:
Sub Button4_Click()
Dim x As Long
Dim erow as Long
'Calculate starting rows
x = 15
With Worksheets("Sheet2")
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
End With
With Worksheets("Sheet1")
Do While .Cells(x, 1) <> ""
'Current code replaces the source data with its values'
.Range("A" & x & ":Y" & x).Value = .Range("A" & x & ":Y" & x).Value
'The next line copies values to Sheet2
Worksheets("Sheet2").Range("A" & erow & ":Y" & erow).Value = .Range("A" & x & ":Y" & x).Value
'increment row counters
x = x + 1
erow = erow + 1
Loop
End With
End Sub
You can't write to a cell's .Formula and then add unrelated data to the same cell's .Value - writing to .Value deletes the formula.
So the following code line:
.Range("A" & x & ":Y" & x).Value = .Range("A" & x & ":Y" & x).Value
is unnecessary (and damaging).
I'm looping through workbooks to aggregate the data to one sheet. The data on the various source sheets is always in the same columns but the rows will vary.
I'm assigning values but conditional formatting is coming through.
Screen updating is off.
How can I copy values from one book to another?
For Each sheet In Workbooks(filename).Worksheets
If sheet.Name = "Template" Then
lastrow = sheet.Range("A" & Rows.Count).End(xlUp).row
For row = 2 To lastrow
All.Range("A" & All_nextrow).Value = sheet.Range("A" & row).Value
All.Range("B" & All_nextrow).Value = sheet.Range("B" & row).Value
All.Range("C" & All_nextrow).Value = sheet.Range("C" & row).Value
All.Range("D" & All_nextrow).Value = sheet.Range("D" & row).Value
All.Range("E" & All_nextrow).Value = sheet.Range("E" & row).Value
All.Range("F" & All_nextrow).Value = sheet.Range("F" & row).Value
All.Range("G" & All_nextrow).Value = sheet.Range("G" & row).Value
All.Range("H" & All_nextrow).Value = sheet.Range("H" & row).Value
All.Range("I" & All_nextrow).Value = sheet.Range("I" & row).Value
All.Range("J" & All_nextrow).Value = sheet.Range("J" & row).Value
All.Range("K" & All_nextrow).Value = sheet.Range("K" & row).Value
All.Range("L" & All_nextrow).Value = Workbooks(filename).Name
All_nextrow = All_nextrow + 1
Next row
End If
Next sheet
This might be what you are looking for. There are some issues with your code you need to know.
In this example, I'm using "All" as the name of the sheet you are putting this onto.
This code uses a simple loop to go through the columns, where you were using Range and the actual letter name of the column, this uses Cells(lRow, lCol) and loops that way, until you get to column L where you change the pattern.
I also removed the for each worksheet, because you are running an IF statement making ONLY "TEMPLATE" the one that will be used. So there is no need to loop through all of them to find the one you know you want. If you meant to use more than that, the If Sheet.Name = "Template" needs to go.
Give this code a shot, and modify it to your needs. I will be happy to modify the answer if you comment with any glitches.
Sub DataAggregate()
Dim sheet As String
Dim all As String
Dim allRow As Long
all = "All" 'whatever the name of "ALL" is, set here.
allRow = 2
sheet = "Template"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row
For lRow = 2 To lastRow
For lCol = 1 To 11
Sheets(all).Cells(allRow,lCol) = Sheets(sheet).Cells(lRow, lCol).Text
Next lCol
Sheets(all).Cells(allRow, "L") = sheet 'or filename' 'confused as to what you want
allRow = allRow + 1
Next lRow
Next ws
End Sub
I'm not sure of understanding what you need but if you want to copy all the cells between A2 and L{lastrow} you can use:
lastrow = SheetFrom.Range("A" & Rows.Count).End(xlUp).Row
SheetFrom.Range("A2:L" & lastrow).Copy
SheetTo.Range("A2").PasteSpecial (xlPasteValues)
Sub CopyPaste()
Dim WorkbookToCopy As Workbook
Dim WorkbookToPaste As Workbook
Dim RowCount As Integer
Set WorkbookToCopy = Workbook1 'Workbook to copy name like Workbook1
Set WorkbookToPaste = Workbook2
RowCount = 1 ' 'clean' row in WorkbookToPaste
For Each Sheet In Workbook1
For Each Column In Sheet
RowCount = 1
For Each Cell In Column
WorkbookToPaste.Sheets(Sheet).Cells(RowCount, Column).Value = Cell.Value
RowCount = RowCount + 1
Next
Next
Next
End Sub
I'm not sure that its work, but I would like to show you some logic, which you can use in your macro.
For anybody still looking for a good answer, the cells format can be controlled with use of 'NumberFormat' in conjunction with .FormulaR1C1.
When any value stored in a cell with ".value" it internally formatted. To override this you need to alter the NumberFormat and use '.FormulaR1C1' instead of '.value'.
All.Range("A" & All_nextrow & ":" & "L" & All_nextrow).NumberFormat = "#"
Then
All.Range("A" & All_nextrow).FormulaR1C1 = sheet.Range("A" & row).Value
You can achieve this by .copy and .PasteSpecial as suggested by #genespos but I'm not a fan of cell interactions during a macro execution.
I am trying to compare cell A1 with B1 and if it is true populate cell F1 with the A1 value. But irrespective of my input values the if condition becomes true.
Sub Macro3()
Dim i As Integer
i = 1
For i = 1 To 10
If (Range("A" & i).Select = Range("B" & i).Select) Then
Range("A" & i).Select
Selection.Copy
Range("F" & i).Select
ActiveSheet.Paste
End If
Next i
End Sub
Instead of selecting, copying, and pasting, you can compare the Value property of the cells, then set the F column Value accordingly:
Dim i As Integer
For i = 1 To 10
If Range("A" & i).Value = Range("B" & i).Value Then
Range("F" & i).Value = Range("A" & i).Value
End If
Next
Consider this a compliment to Nick's answer (accept his if you find it to work, which you should). I wanted to help explain some of the things that are wrong in your code.
Before FIX:
Sub Macro3()
Dim i As Integer
i = 1
For i = 1 To 10
If (Range("A" & i).Select = Range("B" & i).Select) Then
Range("A" & i).Select
Selection.Copy
Range("F" & i).Select
ActiveSheet.Paste
End If
Next i
End Sub
AFTER FIX
Sub Macro4()
Dim i As Long
For i = 1 To 10
If Range("A" & i).Value = Range("B" & i).Value Then
Range("F" & i).Value = Range("A" & i).Value
End If
Next
End Sub
POINTS:
Use Long instead of Integer (small optimization since VBA will convert the int to a long anyway)
No need to declare i = 1 twice in a row
You should be comparing values, not simply selecting cells. There is rarely, if ever, a need to use the .Select keyword. You can access all object's properties directly.
Copy and paste is a heavy operation. Since you are in VBA, may as well just assign the value that is in A to the cell in column B. It's faster, and more effecient.
I hope this helps. BTW, you can simple enter:
=IF(A1=B1,A1,"")
in F1 and drag the formula down to get a similar result.
You can use a variant array to address your performance issue that you raise above. This code will run the same as Nicks except it will skip blanks cell, ie it will
update the F value if A and B are the same
skip updates if the A cell is blank
leave the existing F values in place if A<>B
It wasn't clear to me how you are comparing rows accross two sheets, can you expand on this?
Sub MyArray()
Dim X As Variant
Dim Y As Variant
Dim lngrow As Long
X = Range([a1], Cells(Rows.Count, "B").End(xlUp))
Y = Range([f1], [f1].Offset(UBound(X, 1) - 1, 0))
For lngrow = 1 To UBound(X, 1)
If Len(X(lngrow, 1)) > 0 Then
If X(lngrow, 1) = X(lngrow, 2) Then Y(lngrow, 1) = X(lngrow, 1)
End If
Next
Range([f1], [f1].Offset(UBound(X, 1) - 1, 0)) = Y
End Sub