I have this piece of code
Sub neviem()
Dim ws As Worksheet
Dim i As Range
Dim j As Long
Set i = Range("GKC")
For j = i.Rows.Count To 1 Step -1
If IsEmpty(Range("E3").Value) Then
If i(j, 1) Like Range("E2") Then
i(j, 1).Offset(0, 1).Copy Range("E2").Offset(1, 0)
End If
ElseIf i(j, 1) Like Range("E2") Then
i(j, 1).Offset(0, 1).Copy Range("E2").Offset(1, 0) & "," & Range("E2").Value
End If
Next
End Sub
With this code I'm trying to add multiple text values in the same cell. The first part is ok when I run it, it will add a text value. The problem is when I run it for a second time it gives me an error
runtime err 1004 copy method class failed
so I'm not able to put more text values next to the one I already have.
Is this possible in VBA?
Instead this i(j, 1).Offset(0, 1).Copy Range("E2").Offset(1, 0) & "," & Range("E2").Value
Try this i(j, 1).Offset(0, 1) = Range("E3") & "," & Range("E2")
Related
My code seems to not be working, and I'm not sure why?
Sub Concat()
'Formula to combine the member AC# and Parish Name
Sheets("Risk Partner Data").Select
Dim ACParish As String, i As String
Dim rng As Range
Set rng = Range("A" & Rows.Count).End(x1Up)
ACParish = rng.Row
For i = 2 To ACParish
AcrtiveWorkbook.Sheets("Calc Data").Cells(i, 1) = Cells(i, 1) & Cells(1, 2)
Next i
End Sub
Says that Compile error, Type mismatch and highlights the "i" in For i = 2
My objective:
In another sheet (Risk Partner Data) I have Columns F & E, these are a mixture of text and numbers. I want it to run for all of the active cells in the columns.
I'm new to vba.
i is being used as an integer in the For ... Next but you've declared it as a string; it should be a Long. Same for ACParish.
There is a typo in AcrtiveWorkbook.
You don't need to .Select a worksheet in order mto access it's values.
Should ... = .Cells(i, 1) & .Cells(1, 2) be ... = .Cells(i, 1) & .Cells(i, 2)?
Sub Concat()
'Formula to combine the member AC# and Parish Name
Dim ACParish As long, i As long
with workSheets("Risk Partner Data")
ACParish = .Range("A" & Rows.Count).End(xlUp).row
For i = 2 To ACParish
.parent.workSheets("Calc Data").Cells(i, 1) = .Cells(i, 1) & .Cells(1, 2)
Next i
end with
End Sub
I am working with this macro that will look at a block of transactions, insert 3 rows between months, and then add the month and subtotal. The issue is that the break and totals are getting inserted at the beginning of the month instead of the end.
I have tried to adjust the shift but it either ends up giving me an error or the total ends up overriding an existing cell instead of going into a new row. This is a more complex macro than I have worked with before and I'm a little lost now, still working on learning VBA.
Option Explicit
Sub AddAndSum()
On Error GoTo lblError
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim shData As Worksheet, wbData As Workbook
Dim fr As Long, lr As Long, i As Long, lr2 As Long
Dim intMonth As Long, intYear As Long
Set wbData = ThisWorkbook
Set shData = wbData.Sheets("Sheet1")
fr = 13
lr = shData.Rows.Count
For i = fr To lr
With shData
If (IsDate(.Cells(i, 3).Value) And IsDate(.Cells(i - 1, 3).Value) And Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)) Or i = fr Then
intMonth = Month(.Cells(i, 3).Value)
intYear = Year(.Cells(i, 3).Value)
.Rows(i & ":" & i + 2).Insert Shift:=xlDown
.Cells(i + 1, 1).Value = "Monthly Total (" & MonthName(intMonth) & ")"
.Cells(i + 1, 2).Formula = "=SUMPRODUCT((MONTH($C$" & fr & ":$C$" & lr & ")=" & intMonth & ")*(YEAR($C$" & fr & ":$C$" & lr & ")=" & intYear & ")*$E$" & fr & ":$E$" & lr & ")"
i = i + 3
End If
End With
Next i
lblError:
If Err.Number <> 0 Then
MsgBox "Error (" & Err.Number & "): " & Err.Description, vbOKOnly + vbCritical
End If
GoTo lblExit
lblExit:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculate
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub
This line begins the insertion at Row i.
.Rows(i & ":" & i + 2).Insert Shift:=xlDown
You want to begin the insertion at row i+3, and you can accomplish that with the Offset method:
.Rows(i & ":" & i + 2).Offset(3).Insert Shift:=xlDown
You may also want to see this answer regarding best way of getting the "last row" in a column:
Error in finding last used cell in VBA
As you're currently doing lr = shData.Rows.Count that is 65,336 rows in Excel 2003, or 1,048,576 rows in Excel 2007+ and you almost certainly do not have that many data (otherwise an Insert would fail!), so your loop is cycling needlessly over a bunch of empty rows.
You need to change this row:
intMonth = Month(.Cells(i, 3).Value)
to
intMonth = Month(.Cells(i-1, 3).Value)
At the moment it is setting intMonth to the value of the current cell (which is the first cell of the next month) instead of the value of the previous cell (which contains the month you want to subtotal).
Then add a condition into your loop to add the last subtotal.
Also:
If (IsDate(.Cells(i, 3).Value) And IsDate(.Cells(i - 1, 3).Value) And Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)) Or i = fr Then
Should this be i = lr ? as you are checking for the last line in the sheet? At the moment will always put a subtotal after the first line. You'll need to update this value when you add the three subtotal lines in as well.
I have a small suggestion as I am new to excel vba,
I like to update the some string in a particular cell(j,8) , where t is a string to be update ,t varies from 1 to 10 .
I like to update t value in "alt enter " in a specific cell
if the cell is already fill , I like to add new line
destlastrow = bsmWS.Range("A" & bsmWS.Rows.Count).End(xlUp).Row 'Checking the BSM/CMS/LDP/RCTA (Test Catalog)
For j = 2 To destlastrow
b = onlyDigits(bsmWS.Range("A" & j).value)
If InStr(b, "T") Or InStr(b, "") = 0 Then ' Check if it Test case or Test case ID
' do something
ElseIf InStr(b, "T") Or InStr(b, "D") Then
'do something
ElseIf InStr(b, "P") Or InStr(b, "D") Then
'do something
Else
iComp = StrComp(A, b, vbBinaryCompare)
Select Case iComp
Case 0
With tabWS
Inc value
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Range(.Cells(i, 2), .Cells(i, 3)).Copy .Range(.Cells(value, 8), .Cells(value, 9))
tabWS.Range("B" & i).Interior.ColorIndex = 4
End With 'tabWS
End Select
t = tabWS.Cells(value, 8).value
bsmWS.Cells(j, 8).value = t & vbCrLf
Exit For
End If
Next j
Above is my snippet. I want to update "t" value which I get it from another worksheet, want to update into another worksheet (j,8).
Can someone give a valuable suggestion , how to add new lines in (j,8)
More clarity:
If cell (5,8) has already a value
cell (5,8) = "Already a string"
How can I add a new line in the same cell
dim t as string
t= "new line add"
How I can add t value in the next line to cell(5,8)
To get a new line you can use vbNewLine instead of vbCrLf.
To add to the text already in the cell use you can do it like this
bsmWS.Cells(j, 8).value = bsmWS.Cells(j, 8).value & vbNewLine & t
I have a problem with my code, an error appears, and I don;t understand why. The error is:
"Compile error: Next without For"
I do not understand why it is like that. I am new to coding so any help and comments are more than welcome.
This is the code, the Next which is pointed as the one without For is provided a comment.
Sub CGT_Cost()
startrow = Worksheets("GUTS").Cells(10, 1) 'Here I put 1
endrow = Worksheets("GUTS").Cells(11, 1) 'Here I put 1000
For x = endrow To startrow Step -1
If Cells(x, "Q").Value = "Sale" Then
If Cells(x, "D").Value = "1" Then
For i = 1 To 1000
If Cells(x - i, "R").Value <> "1" Then
Next i
Else
Range("G" & x).FormulaR1C1 = "=R[-" & i & "]C/R[-" & i & "]C[-1]*RC[-1]"
End If
End If
End If
Next x
End Sub
Thank you all in advance,
with best regards,
Artur.
Every For statement with a body must have a matching Next, and every If-Then statement with a body must have a matching End If.
Example:
For i = 1 To 10 '<---- This is the header
Hello(i) = "Blah" '<---- This is the body
Next i '<---- This is the closing statement
You have part of the body of your If statement inside your For i loop, and part of it outside. It has to be either ALL inside or ALL outside. Think through the logic and see what it is you want to do.
you have overlapping loops-perhaps
Sub CGT_Cost()
startrow = Worksheets("GUTS").Cells(10, 1) 'Here I put 1
endrow = Worksheets("GUTS").Cells(11, 1) 'Here I put 1000
For x = endrow To startrow Step -1
If Cells(x, "Q").Value = "Sale" Then
If Cells(x, "D").Value = "1" Then
For i = 1 To 1000
If Cells(x - i, "R").Value <> "1" Then
'
Else
Range("G" & x).FormulaR1C1 = "=R[-" & i & "]C/R[-" & i & "]C[-1]*RC[-1]"
End If
Next i
End If
End If
Next x
End Sub
I have an excel sheet of which the data was jumbled: for example, the data that should have been in Columns AB and AC were instead in Columns B and C, but on the row after. I have the following written which moved the data from B and C to AB and AC respectively:
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("A:A")
i = 1
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell In rRng.Cells
If rCell.Value = "" Then
Range("AB" & i) = rCell.Offset(0, 1).Value
rCell.Offset(0, 1).ClearContents
End If
i = i + 1
If i = lastRow + 1 Then
Exit Sub
End If
Next rCell
End Sub
However, it doesn't fix the problem of the data being on the row BELOW the appropriate row now that they are in the right columns. I am new to VBA Macros so I would appreciate any help to make the data now align. I tried toggling the Offset parameter (-1,0) but it's not working.
Try something like this?
For i = Lastrow To 1 Step -1
' move data into cell AA from Cell A one row down
Cells(i, 27).Value = Cells(i + 1, 1).Value
Next
You don't need to loop through the range to accomplish what you're trying to do.
Try this instead:
Sub MoveBCtoAbAcUpOneRow()
Dim firstBRow As Integer
Dim lastBRow As Long
Dim firstCRow As Integer
Dim lastCRow As Long
' get the first row in both columns
If Range("B2").Value <> "" Then
firstBRow = 2
Else
firstBRow = Range("B1").End(xlDown).Row
End If
If Range("C2").Value <> "" Then
firstCRow = 2
Else
firstCRow = Range("C1").End(xlDown).Row
End If
' get the last row in both columns
lastBRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
lastCRow = Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
' copy the data to the correct column, up one row
Range("B" & firstBRow & ":B" & lastBRow).Copy Range("AB" & firstBRow - 1)
Range("C" & firstCRow & ":C" & lastCRow).Copy Range("AC" & firstCRow - 1)
' clear the incorrect data
Range("B" & firstBRow & ":B" & lastBRow).ClearContents
Range("C" & firstCRow & ":C" & lastCRow).ClearContents
End Sub
Notes:
If the shape of data in each column is the same, you don't need to
find the first and last row for each. You'll only need one variable for each and one copy operation instead of 2.
Make sure you set variable declaration to required.
(Tools -> Options -> Require Variable Declaration) You may already be doing this, but I couldn't tell because it looks like the top of your Sub got truncated.