Copy and paste below the yellow highlighted row - excel

Not sure if this is a possibility but here goes. I'm at a standstill for this vba code. I tried attaching a picture example - not sure if it'll show up correctly.
Everything in blue font, I have created a vba code to copy it directly from the top rows down
1) I need a macro that would look in all the cells in the header row 1 for "Cont Type" and if it finds in it any cell, then in the same column directly below the yellow highlighted row (in this case, it's row 5 but it could change because the data will be updated daily), put in the word "Finance" and the word "Finance" has to go all the way down to match the number of rows in column A.
click on the link to see example of what I'm trying to accomplish
Example

You'll need to use a loop to do so. So something like this:
x = 1 'the starting column to look for content type
Do While cells(1, x) <> "" 'look in every column until your columns are empty
If Cells(1, x) = "Cont Type" Then
Range(Cells(6, x), Cells(n, x)) = "Finance" 'With n equaling your last column to insert this to
Else
End If
x = x + 1 'go to the next column to look
Loop

Try:
Option Explicit
Sub test()
Dim LastColumn As Long, i As Long
'Change sheet name if needed
With ThisWorkbook.Worksheets("Sheet1")
'Find LastColumn of row 1
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Loop Cells of the first row
For i = 1 To LastColumn
'If cells in row 1 and column i is "Cont Type"
If .Cells(1, i).Value = "Cont Type" Then
'Import in range
.Range(.Cells(6, i), .Cells(9, i)).Value = "Finance"
End If
Next i
End With
End Sub
Results:

Related

Adding 3 blank rows when value changes in excel column

I would like to enter 3 blank rows whenever the value in column A changes. I found the following vba code online. Is it possible to adapt this to get it to enter 3 instead of 1 row? I also would like to get rid of the input box. My knowledge of vba is very limited so I apologize for that.
I just need some way to enter 3 blank rows whenever the value in the ID column changes without any sort of input box or other dialogue box. Any help would be much appreciated!
Dim curR As Range
Set curR = Application.Selection
Set curR = Application.InputBox("Select the Range of Cells to be insert blank rows", xTitleId, curR.Address, Type:=8)
For i = curR.Rows.Count To 2 Step -1
If curR.Cells(i, 1).Value <> curR.Cells(i - 1, 1).Value Then
curR.Cells(i, 1).EntireRow.Insert
End If
Next
End Sub
picture
The procedure below will allow you to specify how many rows you want to insert after each change. You can also specify another ID column, simply by changing the value of the constant TargetClm.
Sub Insert3Rows()
' 298
Const TargetClm As String = "A" ' change to suit
Const NumRows As Integer = 3 ' number of rows to insert
Dim R As Long ' loop counter: sheet rows
Application.ScreenUpdating = False
With Worksheets("Sheet1") ' change to suit
' loop from next to last used cell to row 2
For R = (.Cells(.Rows.Count, TargetClm).End(xlUp).Row - 1) To 2 Step -1
If .Cells(R, TargetClm).Value <> .Cells(R + 1, TargetClm).Value Then
.Cells(R + 1, TargetClm).Resize(NumRows).EntireRow.Insert
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
No provision has been made to handle blank rows. Therefore, please don't run the code twice on the same worksheet.

if column A has text and column G is blank then copy row to new spreadsheet

I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")

Copy block of excel fields based on criteria

I am looking for a quick way to fill some fields based on a the following condition. (See image)
I have a list containing 3 columns. I need to fill Column C depending on the letter in Column A. When I go to C34 I would like to automatically search the rows above and based on the letter in Column A copy the 11 names from the latest occurrence above. So in C34-C44 the names from C1-C11 would get copied as a block.
Is there a function in Excel that can do that?
You can use a simple VBA macro with two FOR loops to solve your issue:
Sub CompleteRows()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row 'finds last row in column A
For x = 1 To lastrow 'loop that starts with value 1 and goes all the way to the value of lastrow
If Cells(x, 3).Value = "" Then 'if value in column C is empty then continue on
For y = 1 To lastrow 'second loop that runs through the same range
If Cells(y, 1).Value = Cells(x, 1).Value And Cells(y, 2).Value = Cells(x, 2).Value Then
'If the value of the first column and the value of the second
'column for both values match, then add value to column C
Cells(x, 3).Value = Cells(y, 3).Value
Exit For 'Exit loop if value was found
End If
Next y
End If
Next x
End Sub

VBA code to divide cells if reference cell contain a text

I need to get a VBA code to excel for following criteria.
If any cell in the range of B1 to B500 contains "TOTAL:", divide same row value in column V with same row value in Column P where "TOTAL:" text exists.
Answer should be in same row column M.
I tried to develop the code like this:
Sub test()
Dim r As Range
For Each r In Range("B1", Range("B" & Rows.Count).End(xlUp))
If r.Value Like "TOTAL:" Then
With Range("M1:M10")
r.Formula = "=V5/P1"
End With
End If
Next
End Sub
If you want to learn VBA, I'd recommend you to solve those problems on your own by searching for 'loop through range' and 'compare string' and so on. That would be much more valuable for you on a long-term.
Anyway, for now you can try this. Please note that it doesn't provide any error handling etc...
Search Range:
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row loops through the rows from 1 to the last row with a value in column B. If you, for some reason, want to exclude just that very last row and stop at the second last, just substract 1 from it. If you seriously want a fixed range, change the whole thing to For row = 1 To 500.
Sub test()
Dim ws As Worksheet
Dim row As Long
Set ws = Sheet1 'insert name of sheet
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row
If StrComp(Cells(row, 2).Value, "TOTAL:", vbTextCompare) = 0 Then
Cells(row, 13).Value = Cells(row, 22).Value / Cells(row, 16).Value
End If
Next row
End Sub

Excel - copying text from one cell to another without deleting original content

Basically I have the following scenareo:
2 columns, with 600 rows of data.
I need to copy the data from column 2 and place it at the end of the content in column1 for the same rows. This would result in column 1 having its original content plus the additional content of column 2.
Any information in how I can do this will be greatly appreciated.
Thanks in advance!
Here's a VBA in a simple form. Just create a macro, add these lines to it. Then select your original column (what you're calling column 1), and run the macro.
a = ActiveCell.Value
b = ActiveCell(1, 2).Value
ActiveCell.Value = a + b
The bracketed cell reference is a relative statement - 1, 2 means "same row, one column to the right" so you can change that if you need. You could make it loop by expanding thusly:
Do
a = ActiveCell.Value
b = ActiveCell(1, 2).Value
ActiveCell.Value = a + b
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
Exit Do
End If
Loop
That loop will carry on until it finds a blank cell, then it'll stop. So make sure you have a blank cell where you want to stop. You could also add extra characters into the line that combines.. so in the above example it's ActiveCell.Value = a + b, but you could make it ActiveCell.Value = a + " - " + b or anything else that may help.
This should take the values from column 2 and place them sequentially at the bottom of column 1.
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Dim cl As Range
Dim r As Long
Set rng1 = Range("A1", Range("A1048576").End(xlUp))
Set rng2 = Range("B1", Range("B1048576").End(xlUp))
r = rng1.Rows.Count + 1
For Each cl In rng2
Cells(r, 1).Value = cl.Value
r = r + 1
Next
End Sub
Just keep it simple. Here is the code.
Sub copyCol()
Dim lastRow As Long
lastRow = Range("A65000").End(xlUp).Row
Range("B1:B" & lasrow).Copy Range("A" & lastRow).Offset(1, 0)
End Sub
As this question received a number of views (10,000+) I thought it was important to also share another and far simpler solution:
In cell C1 use the formula:
=(A1 & B1)
This will copy the content of cell A1 and B1 into cell C1. Drag the formula to all other rows (row 600 in my case).
Then copy the column and paste using 'values only'.
You will then have cells in column C containing the content of column A and column B in a single cell on a row-to-row basis.

Resources