why does this not work? Basically i have a list in a single cell i want to split strings ending in "sec" and ones that don't by copying them into different columns.
Sub test_if()
For i = 1 To 300
Cells(i, 2).Select
If Right(Cells(i, 2), 3) = "SEC" Then
ActiveCell.Select
Selection.Copy
Cells(i, 3).Select
ActiveSheet.Paste
End If
If Right(Cells(i, 2), 3) <> "SEC" Then
ActiveCell.Select
Selection.Copy
'Cells(i, 4).Select
ActiveCell.Offset(i - 1, 2).Select
ActiveSheet.Paste
End If
Next i
Cells(1, 1).Select
End Sub
Try this one:
Sub test_if()
Dim i As Integer
For i = 1 To 300
With Cells(i, 2)
If UCase(Right(.Value, 3)) = "SEC" Then
.Offset(, 1).Value = .Value
Else
.Offset(i - 1, 2).Value = .Value
End If
End With
Next i
End Sub
and also read, please, how to avoid using Select/Active statements
Related
I'm trying to have a "Called Sub" paste data after the last row used in the one that is calling the code.
However, I can only manage to have the first sub to paste the first data selected and when "ESTDEUDA" is called it pastes the other data on information first used.
Sub ActualizarFondos()
'Deuda
J = 12
For i = 15 To 26
Sheets("Reporte").Activate
If Cells(i, "C").Value > 0 Then
Range(Cells(i, "C"), Cells(i, "B")).Copy
ActiveSheet.Range(Cells(J, "Z"), Cells(J, "AA")).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Call ESTDEUDA
J = J + 1
End If
Next
End Sub
Sub ESTDEUDA()
J = 12
For i = 3 To 6
Sheets("FondosEstrategia").Activate
If Cells(i, "F").Value > 0 Then
Range(Cells(i, "E"), Cells(i, "F")).Select
Range(Cells(i, "E"), Cells(i, "F")).Copy
Sheets("Reporte").Activate
Range(Cells(J, "Z"), Cells(J, "AA")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
J = J + 1
End If
End Sub
I'd like to know what can be done in order to have the information from sheet "FondosEstrategia" to be pasted after the infomation pasted from sheet "Reporte".
Is there any way that a kind of J = J +1 is applied to "ESTDEUDA" in order to paste after J = J +1 from "ActualizarFondos".
Thanks!
You do not need to use J. Just offset your i value in your first loop to produce desired J value.
On your first loop:
i = 15
J = 12 which is the same is i - 3.
Therefore, you can swap out every instance of J with i - 3.
Next, you can pass i as a parameter (input) into ESTDEUDA using the below method.
Sub ActualizarFondos()
Dim i As Integer
For i = 15 To 26
With Sheets("Reporte")
If .Cells(i, "C").Value > 0 Then
.Range(.Cells(i, "C"), .Cells(i, "B")).Copy
ThisWorkbook.Sheets("WHATSHEET").Range("Z" & i - 3).PasteSpecial Paste:=xlPasteValues
Call ESTDEUDA(i)
End If
End With
Next i
End Sub
Sub ESTDEUDA(i As Integer)
Dim x As Long
For x = 3 To 6
With Sheets("FondosEstrategia")
If .Cells(x, "F").Value > 0 Then
.Range(.Cells(x, "E"), .Cells(x, "F")).Copy
Sheets("Reporte").Range("Z" & i - 3).PasteSpecial Paste:=xlPasteValues
End If
End With
Next x
End Sub
Also, you need to qualify your instances of Range and Cells with a direct sheet. You should avoid relying to Active or Selected sheet.
I'm trying to build a basic macro that will sort my data:
Sub Makro1()
Range("N1").Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste
Range("N2").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
ActiveSheet.Paste
Range("N3").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
My data is N columns and one record takes 3 cells that I would like to copy to one row as above.
Now I would like the VBA to keep copying until data in column N ends.
So N4 to A3, N5 to C3 as so on and on.
I'm pretty new to VBA.
Thanks !
Like this?
Public Sub testing()
Dim i As Long
Application.ScreenpUpdating = False
With ActiveSheet
For i = 1 To .Cells(.Rows.Count, "N").End(xlUp).Row Step 3
.Cells(i + 1, "A") = .Cells(i, "N")
.Cells(i + 1, "D") = .Cells(i + 1, "N")
.Cells(i + 1, "C") = .Cells(i + 2, "N")
Next i
End With
Application.ScreenpUpdating = True
End Sub
Transforms column N to the left as shown:
You can delete or hide empty column A rows with
.Range(.Cells(2, "A"), .Cells(.Cells(.Rows.Count, "N").End(xlUp).Row, "A")).SpecialCells(xlBlanks).Delete
or
.Range(.Cells(2, "A"), .Cells(.Cells(.Rows.Count, "N").End(xlUp).Row, "A")).SpecialCells(xlBlanks).EntireRow.Hidden = True
I'm currently using Excel 2010 and am trying to run some code I put together in VBA for Applications (after hitting alt+F11). I typed up the code in a notepad that appeared after double clicking the project I wanted to work on. I also saved everything as Excel Macro Enabled Workbook (*.xlsm).
I am trying to color the backgrounds of Column D either green or red if columns S, T, and U meet the criteria. If the columns all have a value of 0 then Cell D should be colored green. If not, it should be colored red.
Sub GreenOrRed()
Dim i As Integer
For i = 2 To i = 27293
If (Cells(i, "S").Value = 0 And Cells(i, "T").Value = 0 And Cells(i, "U").Value = 0) Then
Cells(i, "D").Interior.ColorIndex = 10
Else
Cells(i, "D").Interior.ColorIndex = 9
End If
Next i
End Sub
The code runs and doesn't throw any error but it also doesn't do anything. What am I doing wrong?
You are using counter in For loop incorrectly. It should be like this...
For i = 2 To 27293
Changed For condition.
Try this:-
Sub GreenOrRed()
Dim i As Integer
For i = 2 To 27293
If (Cells(i, "S").Value = 0 And Cells(i, "T").Value = 0 And Cells(i, "U").Value = 0) Then
Cells(i, "D").Interior.ColorIndex = 10
Else
Cells(i, "D").Interior.ColorIndex = 9
End If
Next i
End Sub
A slightly different approach:
Sub GreenOrRed()
Dim r As Range, rr As Range
Set rr = Range("D1:D27293")
For Each r In rr
If r.Offset(0, 15).Value = 0 And r.Offset(0, 16).Value = 0 And r.Offset(0, 17).Value = 0 Then
r.Interior.ColorIndex = 10
Else
r.Interior.ColorIndex = 9
End If
Next r
End Sub
You might consider setting one (or two) conditional formatting rules.
Option Explicit
Sub GreenOrRed()
With ActiveSheet
With .Range(.Cells(2, "D"), .Cells(.Rows.Count, "D").End(xlUp))
.Interior.ColorIndex = 9
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=and(sum($S2)=0, sum($T2)=0, sum($U2)=0)")
.Interior.ColorIndex = 10
.StopIfTrue = True
End With
End With
End With
End Sub
I've used individual SUM functions to ensure that any text returns a numerical value of zero.
Alternate AutoFilter method.
Sub GreenOrRedFiltered()
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
With .Range(.Cells(1, "D"), .Cells(.Rows.Count, "D").End(xlUp)).Resize(, 18)
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Columns(1).Interior.ColorIndex = 9
.AutoFilter Field:=16, Criteria1:=0, Operator:=xlOr, Criteria2:=vbNullString
.AutoFilter Field:=17, Criteria1:=0, Operator:=xlOr, Criteria2:=vbNullString
.AutoFilter Field:=18, Criteria1:=0, Operator:=xlOr, Criteria2:=vbNullString
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.Columns(1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 10
End If
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
Private Sub CommandButton1_Click()
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1) = "Wheat" Then
Range(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Select
Selection.Copy
Workbooks.Open Filename:="C:\commodities\allcommodities-new.xlsm"
Worksheets("Sheet2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 51).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next i
For i = 2 To LastRow
If Cells(i, 1) = "Feeder Cattle" Then
Range(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Select
Selection.Copy
Workbooks.Open Filename:="C:\commodities\allcommodities-new.xlsm"
Worksheets("Sheet2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 3).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next i
For i = 2 To LastRow
If Cells(i, 1) = "Corn" Then
Range(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Select
Selection.Copy
Workbooks.Open Filename:="C:\commodities\allcommodities-new.xlsm"
Worksheets("Sheet2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 67).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next i
end sub
NOTE: The code fails at the first "Range" command with a "compile error,
wrong number of arguments, or invalid property assignment" I can get the code to run with 2 cells definitions in the Range command.
While you can state range("B1, C1, D1") you cannot state range("B1", "C1", "D1") which is what you are trying to do.
If you actually want columns 2, 3 and 4 on row i then just use the first and the last like range("B1:D1")
Range(Cells(i, 2), Cells(i, 4)).Select
If the actual columns are a discontiguous group then use Union.
dim rng as range
set rng = union(Cells(i, 2), Cells(i, 4), Cells(i, 6))
rng.select
Please look into How to avoid using Select in Excel VBA macros.
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long, lastRow As Long, nextRow As Long
Dim wbACN As Workbook
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set wbACN = Workbooks.Open(Filename:="C:\commodities\allcommodities-new.xlsm")
For i = 2 To lastRow
Select Case LCase(Cells(i, 1).Value2)
Case "wheat"
Union(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Copy _
Destination:=wbACN.Worksheets("Sheet2").Cells(Rows.Count, "AY").End(xlUp).Offset(1, 0)
Case "feeder cattle"
Union(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Copy _
Destination:=wbACN.Worksheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
Case "corn"
Union(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Copy _
Destination:=wbACN.Worksheets("Sheet2").Cells(Rows.Count, "BO").End(xlUp).Offset(1, 0)
Case Else
'do notbhing
End Select
Next i
wbACN.Close savechanges:=True
End Sub
I am learning visual basic and this script I'm using is coming up with an error when I am initializing the variable i.
I'm not sure what the problem is but I am getting the error message:
Run-time error '1004': Application-defined or object-defined error
Here is my code:
Sub excelmacro()
Sheets("Sheet1").Select
Range("A1").Select
Sheets("Sheet2").Select
Range("B1").Select
i = 1
While i <> 10
If Len(ActiveCell.Value) > 1 Then
Sheets("Sheet1").Select
xname = Right(ActiveCell.Value, Len(ActiveCell.Value) - 6)
xsalary = Right(ActiveCell.Value, Len(ActiveCell.Offset(2, 0).Value) - 8)
xdesignation = Right(ActiveCell.Value, Len(ActiveCell.Offset(1, 0).Value) - 13)
Sheets("Sheet2").Select
ActiveCell.Value = xname
ActiveCell.Offset(0, 1).Value = xdesig
ActiveCell.Offset(0, 3).Value = xsalary
ActiveCell.Offset(1, 0).Select
Sheets("Sheet1").Select
ActiveCell.Offset(3, 0).Select
Else
i = 10
End If
Wend
End Sub
you do not need the variable i in your code anyway! just kick the line initializing i out.
The if statement in your loop that uses i is basically to escape the loop and can be shortened to:
While Len(ActiveCell.Value) > 1
Sheets("Sheet1").Select
xname = Right(ActiveCell.Value, Len(ActiveCell.Value) - 6)
xsalary = Right(ActiveCell.Value, Len(ActiveCell.Offset(2, 0).Value) - 8)
xdesignation = Right(ActiveCell.Value, Len(ActiveCell.Offset(1, 0).Value) - 13)
Sheets("Sheet2").Select
ActiveCell.Value = xname
ActiveCell.Offset(0, 1).Value = xdesig
ActiveCell.Offset(0, 3).Value = xsalary
ActiveCell.Offset(1, 0).Select
Sheets("Sheet1").Select
ActiveCell.Offset(3, 0).Select
Wend
This may be a good time to start practising the methods detailed in How to avoid using Select in Excel VBA macros.
Your code is repeatedly retrieving different lengths of the right-most characters from ActiveCell but using the length of the values from rows below the active cell to determine how many characters to retrieve. It seems that you should be retrieving the characters from the same cell that you are using to determine the length.
Sub excelmacro()
Dim i As Long, xname As String, xsalary As String, xdesignation As String
With Sheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 3
If CBool(Len(.Cells(i, "A").Value)) Then
xname = Right(.Cells(i, "A").Value, Len(.Cells(i, "A").Value) - 6)
xdesignation = Right(.Cells(i + 1, "A").Value, Len(.Cells(i + 1, "A").Value) - 13)
xsalary = Right(.Cells(i + 2, "A").Value, Len(.Cells(i + 2, "A").Value) - 8)
With Sheets("Sheet2")
.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = xname
.Cells(Rows.Count, "B").End(xlUp).Offset(0, 1) = xdesignation
.Cells(Rows.Count, "B").End(xlUp).Offset(0, 3) = xsalary
End With
End If
Next i
End With
End Sub
I've retained your use of a string variable for the salary although you may be better served by using a variable of type double and converting the text with a CDbl() wrapper. The second use of xdesig instead of xdesignation was corrrected.