Very new to VBA and macros. Looking to build a macro that will cut the items in G2:H2, paste them in I2:J2, skip to the next even numbered row, cut those items (G4:H4), paste those into I4:J4, and so-on until the end of the spreadsheet. The spreadsheet has roughly 11200 rows to sort through. Any help is GREATLY appreciated!
Sub TotalMove()
'
' TotalMove Macro
a = 2
g = Sheet17.Cells(Rows.Count, "A").End(xlUp).Row
For a = 2 To g Step 2
Range("G2:H2").Select
Selection.Cut
Range("I2:J2").Select
ActiveSheet.Paste
Next a
End Sub
You almost had it, was just a case of using your row number in the loop.
I made the variable names obvious for demo, set values rather than copy-paste, and specified the sheet in ranges.
Sub TotalMove()
With Sheet17
StartRow = 2
EndRow = .Cells(Rows.Count, "G").End(xlUp).Row
For CurrentRow = StartRow To EndRow Step 2
.Range("I" & CurrentRow & ":J" & CurrentRow) = .Range("G" & CurrentRow & ":H" & CurrentRow).Value
.Range("G" & CurrentRow & ":H" & CurrentRow).Clear
Next CurrentRow
End With
End Sub
Related
I am new in VBA so i just look for the code online and i modify it for my files.
I would like to know if i can put together the following 2 macros.
It looks for contract number in column AF and then changes the Customer Name (col AN) & Customer Group Name (col AP). can it be donein another way?
I would like to simplify it as later i need, based on Contract Number to change 5 more variables in 5 different columns for other customers.
Sub CorrectCustomerNameXXXX()
Dim LastRow As Long
Dim i As Long
LastRow = Range("AF1000000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("AF" & i) = "006-0146157-001" Then
Range("AN" & i).Value = "CUSTOMER_NAME"
End If
Next
End Sub
Sub CorrectCustomerGROUPNameXXXX()
Dim LastRow As Long
Dim i As Long
LastRow = Range("AF1000000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("AF" & i) = "006-0146157-001" Then
Range("AP" & i).Value = "CUSTOMER_GROUP"
End If
Next
End Sub
Thanks in advance for your help
Try this code, please. You should use the same iteration:
Sub CorrectWhatever()
Dim LastRow As Long, i As Long
LastRow = Range("AF" & rows.count).End(xlUp).Row
For i = 1 To LastRow
If Range("AF" & i).Value = "006-0146157-001" Then
Range("AN" & i).Value = "CUSTOMER_NAME"
Range("AP" & i).Value = "CUSTOMER_GROUP"
End If
Next
End Sub
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.
I have a user input transaction information (Name, Amount, Date) in cells E33:G33.
User clicks button and the transaction is recorded in the last row +1 used in a Transaction history list starting on E46:G46.
So far my code doesnt work.
i want simply:
-copy range (E33:G33)
-find last row used in column E
-go one row lower
-past the copied range
Cant find a working answer, please help! Thanks.
use this:
Sub test()
Dim e&: e = Cells(Rows.Count, "E").End(xlUp).Row + 1
Range("E" & e & ":G" & e).Value = [E33:G33].Value 'past only values
End Sub
or
Sub test2()
Dim e&: e = Cells(Rows.Count, "E").End(xlUp).Row + 1
[E33:G33].Copy Range("E" & e & ":G" & e) 'past with cells format
End Sub
or
Sub test3()
Dim e&: e = Cells(Rows.Count, "E").End(xlUp).Row + 1
[E33:G33].Copy
Range("E" & e & ":G" & e).PasteSpecial xlPasteAll 'past with cells format
End Sub
or
Sub test4()
Dim e&: e = Cells(Rows.Count, "E").End(xlUp).Row + 1
[E33:G33].Copy
Range("E" & e & ":G" & e).PasteSpecial xlPasteValues 'past only values
End Sub
also:
[E33:G33] can be replaced by:
Range("E33:G33")
or
Cells(Cells(33,"E"),Cells(33,"G"))
or
Cells(Cells(33,5),Cells(33,7))
I have a problem making a little VBA to copy/paste some datas. I looked around and didn't really find any post who talk of my problem.
Here is my problem: I have 3 worksheets who need to be copied on a fourth worksheet. Each worksheet have between 200 and 650 lines. On the three sheets, it's the columns A, I, J, K, L, M,N who need to be copied on the columns A, C, D, H, I, M, N. The copy paste action need to start on the first blank line of the fourth sheet. This is the last constraint who make it a lot more difficult than I expected. I tried two ways and haven't managed to make it works.
Here is the code (one way is in comments form)
Dim Sh as Worksheet
Dim i as Integer
For Each Sh In Sheets(Array("Janvier", "Février", "Mars"))
For i = 4 To 650
Worksheets("Sh").Range("A & i").Copy Destination:=Worksheets("Calculs").Range("A" & Sheets("Calculs").UsedRange.Rows.Count + 1)
Worksheets("Sh").Range("I & i:J & i").Copy Destination:=Worksheets("Calculs").Range("I" & Sheets("Calculs").UsedRange.Rows.Count + 1)
Worksheets("Sh").Range("K & i:L & i").Copy Destination:=Worksheets("Calculs").Range("K" & Sheets("Calculs").UsedRange.Rows.Count + 1)
Worksheets("Sh").Range("M & i:N & i").Copy Destination:=Worksheets("Calculs").Range("M" & Sheets("Calculs").UsedRange.Rows.Count + 1)
'Sheets("Calculs").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Sheets(Sh).Range("A4:A650").Value
'Sheets("Calculs").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = Sheets(Sh).Range("I4:J650").Value
'Sheets("Calculs").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Sheets(Sh).Range("K4:L650").Value
'Sheets("Calculs").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Sheets(Sh).Range("M4:n650").Value
Next i
Next Sh
My error after executing the code not in comments form is "Subscript out of range". Can you propose me a better way to code this.
Thank you for your help, Olivier
Try using the .Cells method instead of .Range. Like so:
Worksheets("Sh").Cells(i, 1) ...
Where the first parameter is your row and the second is your columns (A=1, B=2, ect).
Try this:
Sub Tester()
Dim Sh As Worksheet, ws As Worksheet, rw As Range
Dim i As Integer
Set ws = Worksheets("Calculs")
'get first empty row
Set rw = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
Application.ScreenUpdating = False
For Each Sh In Sheets(Array("Janvier", "Février", "Mars"))
For i = 4 To 650
Sh.Range("A" & i).Copy rw.Cells(1, "A")
Sh.Range("I" & i & ":J" & i).Copy rw.Cells(1, "I")
Sh.Range("K" & i & ":L" & i).Copy rw.Cells(1, "K")
Sh.Range("M" & i & ":N" & i).Copy rw.Cells(1, "M")
Set rw = rw.Offset(1, 0)
Next i
Next Sh
End Sub
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