This question already has answers here:
Add line breaks in cell to 1000 rows of data
(3 answers)
Closed 6 years ago.
I am naïve to macros and I need a macro button to enter line break at the end of every data in the row. I have around 1000 rows of data in specific columns. I need to apply this to selected columns. I am currently using ALT+ENTER, but it is time consuming.
Any help would be much appreciated.
I am currently using below code
Sub Macro
Dim Stem As Variant
Stem = ThisWorkbook.Worksheets ("Sheet1").Range("C2")
Range ("K2").Select
Range("K2").FormulaR1C1 = Stem & Chr(10) & ""
End Sub
Above code copies only C2 data and paste in K2 and apply formula. But I need all data in column C2:C to be copied and pasted in K2:K.
Thanks
If I understand that correctly, you want to loop through the copied records in column K and add a line break?
In that case you can use this (this will copy all columns starting from 1) and loop through cells in K starting from 2, you can change that if needed:
Sub copyAndNewLine()
'copy column C to K
Columns("C").Copy Destination:=Columns("K")
'loop through all cells in K and add new line
For i = 2 To Cells(Rows.Count, "K").End(xlUp).Row
Cells(i, "K").Value = Cells(i, "K").Value & vbCrLf
Next i
End Sub
Related
I have numerous excel sheets that contain rows that have paired data. Specifically, I need to subtract the first row from the one that follows (e.g., row 2-row 1; row 4-row3; etc.) and place the result into a new row below each pair. My data in each sheet appear as follows:
I am not new to programming languages, but I am new to visual basic.
My current code is:
Sub test() Dim rng As Range
Columns(1).Insert
With Range("b2", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
.Formula = "=if(mod(row(),2)=1,1,"""")"
.Value = .Value
.SpecialCells(2, 1).EntireRow.Insert
End With
Columns(1).Delete
With Range("a1", Range("a" & Rows.Count) _
.End(xlUp)(2)).Resize(, 3)
.Columns(1).SpecialCells(4).Value = "Difference"
Union(.Columns(2).SpecialCells(4), .Columns(3) _
.SpecialCells(4)).Formula = _
"=r[-1]c-r[-2]c"
End With
End Sub
However, the result is this:
I am mainly interested in calculating the differences between row pairs in the first column shown, but it is clearly not working.
Any help would be greatly appreciated!
Easier to use formulae, rather than VBA.
Go to a second sheet in the file ("Sheet2")
Enter in A1: =Sheet1!A1-Sheet1!A2
On Sheet2, select Rows1 AND 2.
Drag down.
Then depends on what you need to do.
May be Copy | Paste Special | Values to Sheet3, and sort to remove blank rows.
This question already has answers here:
Excel VBA Delete Rows
(1 answer)
Faster way to delete rows 40k+ rows at once
(2 answers)
Closed 3 years ago.
The below code only seems to work on the first result. I have to re-run it for the other results to be removed. Could anyone take a look and tell me why please? Thanks
I've tried copy and pasting the code several times to compensate but it gives me an error about duplicate code
Dim cell As Range
For Each cell In [AE1:AE2000]
If cell.Value = "REMOVE" Then Range(cell.Offset(0, -5).Address & ":" & cell.Offset(0, 0).Address).Delete Shift:=xlUp
Next cell
One thing you must do when deleting rows is loop backwards; otherwise you may skip rows, which is what is happening to you by the sounds of it. You have to use a counter when looping backwards, such as
Sub x()
Dim r As Long, cell As Range
Set cell = Range("AE1:AE2000")
For r = cell.Count To 1 Step -1
If UCase(cell(r).Value) = "REMOVE" Then
Range(cell(r).Offset(0, -5), cell(r)).Delete Shift:=xlUp
End If
Next r
End Sub
This question already has answers here:
Copy every nth line from one sheet to another
(8 answers)
Closed 7 years ago.
Suppose I have a table in excel containing 1000 rows and 10 columns.
How can I copy every 7th row from this table to a new table whose first row will be this 7th row, second row will be that table 14th row and so on.
I have never done these kind of things in excel before.
How to do it?
If you want to stick with plain Excel (no VBA). Add two columns at the end of your table. The first being a count of the line, the second flagging if the line count is divisible by 7 - I used the formula =IF(MOD(D4,7)=0,"Divisible by 7", "-").
Then filter the table on the 'Mark every 7th item' column, and copy and paste to new table.
You need a macro. Press alt + F11
Basically you run that macro that goes like this
sub Copyer()
dim I as integer
Dim K as integer
I = 7
K = 1
while (Activesheet.Range("A" & I ).Value <> "")
DestinationSheet.Range("A" & K ).Value = Activesheet.Range("A" & I).Value
K = K + 1
I = I + 7
Loop
End Sub
Code may need some grooming but that's the idea
I'm new here and I apologize in advance in my question isn't clear... I couldn't find the answer after some research...
I'm looking for a way to go through all the cells of column "R" and if one cell on a given row contains "Y", then the values of cells at columns "W","X" and "Y" will take the same value as the columns "F","G" and "H" (always at the same row).
The goal is to have a button that will execute the VBA code in order to do this (instead of having to copy/paste all the time).
Thank you very much in advance for your help.
A poor ignorant but motivated VBA beginner...
Here is VBA which will do what you want. It takes advantage of the replacement operation being cells that are next to each other by using Resize.
Highlights
Iterates through each cell in column R. I used Intersect with the UsedRange on the sheet so that it only goes through cells that have values in them (instead of all the way to the end).
Checks for "Y" using InStr.
Replaces the contents of columns WXY with values from columns FGH. Since they are contiguous, I did it all in one step with Resize.
Code:
Sub ReplaceValuesBasedOnColumn()
Dim rng_search As Range
Dim rng_cell As Range
'start on column R, assume correct sheet is open
Set rng_search = Range("R:R")
For Each rng_cell In Intersect(rng_search, rng_search.Parent.UsedRange)
'search for a Y, case sensitive
If InStr(rng_cell, "Y") > 0 Then
'update the columns as desired
'takes advantage of cells being next to each other
Range("W" & rng_cell.Row).Resize(1, 3).Value = Range("F" & rng_cell.Row).Resize(1, 3).Value
End If
Next rng_cell
End Sub
I tested it on my end, and it works, producing the following after running:
Sorry if this is a stupid question(I searched and couldn't find a answer.) I was trying to find out if this was possible with functions but it seems like I will need to use a macro, I don't have any experience with them but can learn.
I am trying to compare 2 cells in sheet 1, Resource name and project code(C and L) against two of the same named columns in sheet 2(where they are A and D). The Resource name is formatted like: Lanier, Joe so its last name comma space first name. Project code is a mix of letters and numbers with no spaces. If they are the same, I would like to copy a range of cells in sheet 1(T through Y) into the matching row's columns X through AC in sheet 2. It would overwrite any data in those cells.
If it is also possible, if there was a way to highlight the cells or rows that don't have a match that would be such a great help so my boss would know what he needed to manually copy over. Thanks so much!
EDIT: Included below macro that seems like it should work but isn't. It is highlighting all of the cells. Any idea what could be changed?
Sub ertert()
Dim i&, j&, s$, col As New Collection
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Sheet2")
For i = 1 To .Cells(Rows.Count, 3).End(xlUp).Row
s = .Cells(i, 1) & "~" & .Cells(i, 3)
If IsEmpty(.Item(s)) Then col.Add i, s
Next i
End With
With Sheets("Sheet1")
.Columns(1).Interior.Color = xlNone
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
s = .Cells(i, 3) & "~" & .Cells(i, 12)
If IsEmpty(col.Item(s)) Then
.Cells(i, 1).Interior.Color = vbYellow
Else
j = col.Item(s)
Sheets("Sheet2").Cells(j, 5).Resize(, 6).Value = .Cells(i, 24).Resize(, 6).Value
End If
Next i
End With: Application.ScreenUpdating = True
End Sub
edited July 23 - 10:30EST
no VBA or macro needed you can use simple formulas and some copy and paste
on sheet2, at the end of the data columns, create a new column (AD?) with this formula
=IF(AND(IFERROR(VLOOKUP(A4,[book1]sheet1!$C$4:$C$14,1,FALSE),"")<>"",IFERROR(VLOOKUP(D4,[book1]sheet1!$L$4:$L$14,1,FALSE),"")<>""),[book1]sheet1!T4,X4)
and copy it over the next 6 rows (AD to AI)
I assumed the first row being 4 and the formula is searching 10 rows in sheet 1, adjust as needed then copy down to last of your data rows
if you have a match, the sheet1 data will be displayed otherwise, sheet2 data will be there
copy this chunk, go to X4 and use EDIT - PASTE SPECIAL - VALUES if excel 2003 or click the PASTE button on upper left and choose PASTE VALUES if Excel 2007+
I recommend you get information on VLOOKUP to better understand this solution
cheers