How to insert new line in the same cell - vba

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

Related

Adding multiple values in one cell

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")

VBA, All my data is in a single column. How do I scan and grab all the relevant info?

My Data : http://imgur.com/a/R9wZp
My code so far:
Sub Leads()
ActiveSheet.Range("J:J").Select
For i = 1 To 100
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")
Next i
End Sub
I want to scroll down J column and everytime the value "Another Car" and a portion of "Mikes Auto Shop" springs up I want to copy and paste the row RIGHT under it into the "L,M, and O" column within the same row.
Just like this http://imgur.com/a/Bt3A5 but would cycle through hundreds of lines of code
Really really appreciate the help everyone, thanks!
This will work given a few assumptions, like, there's no apostrophe in Mikes Auto Shop and that the first space in the car model is the correct place to split the data.
Option Compare Text
Sub test()
Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
For i = 1 To LastRow
If ActiveSheet.Cells(i, 10).Value = "Another Car" Then
If InStr(1, Cells(i + 3, 10).Value, "Mikes Auto Shop", vbTextCompare) <> 0 Then
SplitVal = Split(Cells(i + 1, 10).Value, " ", 2)
Cells(i + 1, 12).Value = SplitVal(0)
Cells(i + 1, 13).Value = SplitVal(1)
Cells(i + 1, 15).Value = Cells(i + 4, 10).Value
End If
End If
Next i
End Sub
Edit as per comment request. I'm not sure where you want the output, you can adjust OutputOffset, Mikes Auto Shop row is 0, -1 is up, +1 is down.
Sub test()
Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String
Dim OutputOffset As Long
OutputOffset = 0
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
For i = 2 To LastRow
If InStr(1, Cells(i, 10).Value, "Mikes Auto Shop", vbTextCompare) <> 0 Then
SplitVal = Split(Cells(i - 1, 10).Value, " ", 2)
Cells(i + OutputOffset, 12).Value = SplitVal(0)
Cells(i + OutputOffset, 13).Value = SplitVal(1)
Cells(i + OutputOffset, 15).Value = Cells(i + 1, 10).Value
End If
Next i
End Sub
Let's start from your code:
Sub Leads()
ActiveSheet.Range("J:J").Select
For i = 1 To 100
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")
Next i
End Sub
What I would do:
Get rid of ActiveSheet.Range("J:J").Select as it might be slow to work with selection
Note: For i = 1 To 100 will take the rows from 1 to 100. You might want to actually use a dynamic method to check that number. You can check the following: https://stackoverflow.com/a/11169920/2012740.
If you get rid of the selection, remove also the ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1") will become:
If Cells(i,10).Value = "Another Car" Then 'This condition is the same as before
SplitedValue = Split(Cells(i+1,10).Value," ") ' With this code you will split the value from the first row below the row which contains "Another Car" text. The value is splitted by " " (empty space). For more references and parameters you can read about the other parameters of `split` function
Cells(i+1,12).Value = SplitedValue(0) 'This will add the first part of the splitted string in the cell which is one row below the current row, and on column 12 (L)
Cells(i+1,13).Value = SplitedValue(1) 'This will add the second part of the splitted string in the cell which is one row below the current row, and on column 13 (M)
Cells(i+1,15).Value = Cells(i+4,10).Value ' This will add the value from the cell which is located 4 rows below the current cell, to the cell which is located one row below the current row and on column 15 (O)
EndIf 'Close the if statement here
Remember to declare dim SplitedValue as Variant

vba code not taking correct value of a cell from file

This is my code:
Dim RowLast As Long
Dim sunmLast As Long
Dim tempLast As Long
Dim filterCriteria As String
Dim perporig As Workbook
Dim x As String
tempLast = ThisWorkbook.Sheets("combine BOMs").Cells(Rows.Count, "E").End(xlUp).Row
Range("D5:G" & tempLast).ClearContents
Range("G5:G" & tempLast).Interior.ColorIndex = 0
tempLast = ThisWorkbook.Sheets("combine BOMs").Cells(Rows.Count, "A").End(xlUp).Row
Range("A5:A" & tempLast).ClearContents
tempLast = ThisWorkbook.Sheets("combine BOMs").Cells(Rows.Count, "B").End(xlUp).Row
'Perpetual
Set perporig = Workbooks.Open("\\Etnfps02\vol1\DATA\Inventory\Daily tracking\perpetual.xlsx", UpdateLinks:=False, ReadOnly:=True)
RowLast = perporig.Sheets("perpetual").Cells(Rows.Count, "A").End(xlUp).Row
perporig.Sheets("perpetual").Cells(3, 1) = "Part Number"
For i = 5 To tempLast
Cells(i, 1) = i - 4
perporig.Sheets("perpetual").AutoFilterMode = False
filterCriteria = ThisWorkbook.Sheets("combine BOMs").Range("B" & i).Value
perporig.Sheets("perpetual").Range("A3:J" & RowLast).AutoFilter Field:=1, Criteria1:=filterCriteria
Counter = perporig.Sheets("perpetual").Cells(RowLast + 1, 1).End(xlUp).Row
If Counter = 3 Then
Cells(i, 5).Value = "Not on perpetual"
Else
ThisWorkbook.Sheets("combine BOMs").Cells(i, 5).Value = WorksheetFunction.Sum(perporig.Sheets("perpetual").Range("H4:H" & RowLast).SpecialCells(xlCellTypeVisible))
x = perporig.Sheets("perpetual").Cells(Cells(RowLast + 1, 1).End(xlUp).Row, 4).Value
MsgBox x, vbOKOnly, perporig.Sheets("perpetual").Cells(RowLast + 1, 1).End(xlUp).Row
ThisWorkbook.Sheets("combine BOMs").Cells(i, 4).Value = x
End If
perporig.Sheets("perpetual").AutoFilterMode = False
Next
perporig.Close savechanges:=False
This is the file from which I am clicking my button (or ThisWorkbook)
This is the perpetual file when it is running on the last row of data:
Notice the difference in D9280: it shows stocking type as "P" in the perpetual file, but "B" in my final result, which comes up in cell D12 in ThisWorkbook. To debug, I created a Msgbox prompt for everytime it gets that value for all rows. For every other row, it gives the correct value ("P"), but for this one, msgbox shows "B". The title of the msgbox is the row number, which shows it is taking the correct row whilr getting the value, just that I don't know why it is taking wrong value. I have tried for different data sources, it seems to be coming up with "B" in wrong places every so often.
In the code, just above the line, I have the line to get the on hand quantity, which it does take correctly (I used xltypevisible to paste values for this field, but that is only because I wanted a sum of the results and this was the only way I knew). It's only this stocking type column which shows wrong values randomly.
Any ideas?
Thanks!
1)
Cells(i, 1) = i - 4
as it is written , it refers to perporig.Cells(i, 1)
is this what you want?
2)
perporig.Sheets("perpetual").Range("A3:J" & RowLast).AutoFilter Field:=1, Criteria1:=filterCriteria
would filter from row 3, while you have headers in row 4 and data from row 5 downwards
change it to
perporig.Sheets("perpetual").Range("A4:J" & RowLast).AutoFilter Field:=1, Criteria1:=filterCriteria
3)
what do you think is Counter doing? Not certainly count visible rows only
Credits to findwindow, I found the answer. The .cells(cells()) part didn't have the correct sheet reference for the inner cells():
Instead of
x = perporig.Sheets("perpetual").Cells(Cells(RowLast + 1, 1).End(xlUp).Row, 4).Value
MsgBox x, vbOKOnly, perporig.Sheets("perpetual").Cells(RowLast + 1, 1).End(xlUp).Row
I used this:
With perporig.Sheets("perpetual")
x = .Cells(.Cells(RowLast + 1, 1).End(xlUp).Row, 4).Value
MsgBox x, vbOKOnly, .Cells(RowLast + 1, 1).End(xlUp).Row
End With
And it worked.
Thanks for your help!

Compile error: Next without For || VBA

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

Create macro to move data in a column UP?

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.