I am trying to create a Macro which will help me look for "," and if it finds it. It will copy the entire row without the first "," it sees and insert another row underneath.
For example. 9877352, 9877354
It will turn that one line into two lines with the same information.
Only different is 9877352 will be on one row and then 9877354 will be in the following row in the same table.
Code So Far:
Sub comma()
Dim i As Long
Dim text As String
Dim myCell As Range
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To FinalRow
thisvalue = Cells(i, 5).Value
If thisvalue Like "*,*" Then
Cells(i, 5).EntireRow.Copy
'I don't know what to put here
'Cells(i, 5).EntireRow.Insert
End If
Next i
End Sub
If there is a chance of there being more than two commas in a cell, I would use an array. Does the column ever change? If not I would do something like this...
Sub comma()
Dim Order As Variant, cell As Range
For Each cell In Range("E:E") 'Enter static column reference here
If cell.Value Like "*,*" Then
Order = Split(cell, ",")
For i = LBound(Order) To UBound(Order)
If i = 0 Then
cell.Value = Order(i)
Else
cell.EntireRow.Copy
cell.EntireRow.Insert
Range("E" & cell.Row) = Trim(Order(i))
End If
Next i
Else
End If
Next cell
End Sub
Related
i am looking for a solution to my problem. The task is to compare two consecutive rows with each other,in the range from column D1 to the last written cell in Column D. If the value of a consecutive cell is equal to the value of the previous cell , i.e. D2=D1, the macro can go next, else it shall insert a new row between the two values. Since i am fairly new to vba and mostly use information based on online research, i could not find a fitting solution til now. Below you can see a part of what tried.
Sub Macro()
'check rows
Dim a As Long
Dim b As Long, c As Long
a = Cells(Rows.Count, "D").End(xlUp).Row
For b = a To 2 Step -1
c = b - 1
If Cells(b, 4).Value = Cells(c, 4).Value Then
If Cells(b, 4).Value <> Cells(c, 4).Value Then
Rows("c").Select
Selection.Insert Shift:=xlDown
End If
End If
Next b
End Sub
Sub InsertRows()
Dim cl As Range
With ActiveSheet
Set cl = .Cells(.Rows.Count, "D").End(xlUp)
Do Until cl.Row < 2
Set cl = cl.Offset(-1)
If cl.Value <> cl.Offset(1).Value Then cl.Offset(1).EntireRow.Insert
Loop
End With
End Sub
Side note. You can benefit from reading How to avoid using Select in Excel VBA
I would like to prepare a tool which searches for anything in certain column, and if see anything, copy this value and paste this in few elements on its row
For example if in G2 there is value "ADD", then A2+B2 + E2 + F2 would be an "ADD" to (except C)
Its very hard for me to overcome obstacles, so far I came up with that.. I know this code is hard to bear with but I rarely use VBA so i never had a chance to learn so its mix of what I've found here on stackoverflow combined as per my requirements
Dim wb as Workbook
Dim ws As Worksheet
wb = ActiveWorkbook.Name
ws = Application.ActiveSheet
With ws
Set myRange = Range("G1", Range("G1").End(xlDown))
For i = 1 to myRange
if i <>"" Then
Range("A1", Range("A1").End(xlToRight)).Select
Range("A1", Range("A1").End(xlToRight)).Value = i.text
[I know this part will do from the first element of A to the last but I dont know how to choose elements I wish if they're not one next to each other]
Next i
End with
For what you want to do, it seem you don't need to declare "wb" and "ws". Vba default will use the ActiveSheet. Also wb is declared to be workbook, but ActiveWorkbook.Name is acutally an text. Your code will encounter error.
If you want to loop from G1 to its last inputted cell, you can refer to following code:
For i = 1 To Cells(Rows.Count,7).End(xlUp).Row
The rows.count refer to the last row (1048576) in excel. and "end(xlup)" will find the last cell which inputted value at G column. And the ".row" return the row number of the last cell.
Similarly, you can use "Cells(1, Columns.Count).End(xlToLeft)" to find the last column's cell inputted at row 1
You may try below code:
For i = 1 To Cells(Rows.Count, 7).End(xlUp).Row
If Cells(i, 7).Value <> "" Then
Range(Cells(i, 1), Cells(i, 2)).Value = Cells(i, 7).Value
Range(Cells(i, 4), Cells(i, Columns.Count).End(xlToLeft)).Value = Cells(i, 7).Value
End If
Next i
However, You mention you want to copy except C column. Since I dont know what actual condition that you will not copy to the column. I just simply separate the code into 2 parts, one for A and B column, another one for D to the last columns
One option could be the following:
Sub FindAndCopy()
Dim ws As Worksheet, searchRng As Range, cl As Range, searchTerm As Variant
Set ws = ThisWorkbook.ActiveSheet
With ws
Set searchRng = .Range("G1", .Range("G1").End(xlDown))
searchTerm = "ADD"
For Each cl In searchRng
If cl = searchTerm Then
Range("A" & cl.Row) = searchTerm
Range("B" & cl.Row) = searchTerm
Range("E" & cl.Row) = searchTerm
Range("F" & cl.Row) = searchTerm
End If
Next cl
End With
End Sub
I have a some data where I have some conditions. If each cell in column B contains words like "and", "or", "and/or", then create a copy of that row and insert it into next row following the copied row.
Currently my data looks like this:
This is my code:
Sub Macro2()
Dim rng As Range, cell As Range, rowRange As Range
Set rng = Range("B1", Range("B1").End(xlDown))
Dim values As Variant
Dim Result() As String
connectorArray = Array("and/or", "or", "and")
Dim findConnectorWord As String
'Worksheets("Sheet1").Activate
'Range("B1", Range("B1").End(xlDown)).Select
For Each cell In rng
findConnectorWord = FindString(cell.Value, connectorArray)
If findConnectorWord <> vbNullString Then
Result() = Split(cell, findConnectorWord)
Set rowRange = Range("A" & cell.Row, Range("B" & cell.Row).End(xlToRight))
rowRange.Copy
rowRange .Offset(1, 0).Insert Shift:=xlDown
'Logic to skip the next cell
End If
Next cell
End Sub
Function FindString(SearchString As String, arr As Variant) As String
For Each searchWord In arr
If InStr(SearchString, searchWord) > 0 Then
FindString = searchWord
Exit For
End If
Next
End Function
The problem that I am having is that once the row is copied and inserted into the next row, the next iteration reads the copied row("Homeowners or Dwelling Fire") and creates another copy. What I would like to do is to skip the cell once the row is copied, inside the if condition and look at Cell B3(Assuming that Umbrella (C) gets pushed down when the new cell is copied over). What's the best possible way to do this?
One of the possible options for implementing what #freeflow wrote about in his comment:
...
Set cell = Range("B1").End(xlDown) ' start from last cell
Do Until False
findConnectorWord = FindString(cell.Value, connectorArray)
If findConnectorWord <> vbNullString Then
...
Set rowRange = cell.EntireRow
rowRange.Copy
rowRange.Offset(1, 0).Insert Shift:=xlDown
End If
If cell.Row = 1 Then Exit Do ' First row? Enough
Set cell = cell.Offset(-1, 0) ' Shift up
Loop
...
And one more note - when defining values for connectorArray, add spaces to the terms: " and " instead of "and". Otherwise, you can duplicate the line with some Brandon or Alexandra
So data gets pasted in to column B as the code keeps running it'll do a condition check to see there's any values in column B and paste a value in to the adjacent column A. I need to make it so it does two condition checks:
If there's values in column b, but then to check if there's values in column A before pasting so it doesn't overwrite different data that's been pasted already.
For Each Cell In y.Sheets("Compiled").Range("A:B")
If Range("B:B").Value <> "" And Range("A:A").Value = "" Then
Cell.Offset(0, -1).PasteSpecial xlPasteValues
End If
Next
You were close, don't try to loop over a multiple column range:
Sub Test()
For Each Cell In y.Sheets("Compiled").Range("B:B")
If Cell.Value <> "" And Cell.Offset(0, -1).Value = "" Then
Cell.Offset(0, -1).Value = Cell.Value
End If
Next
End Sub
NOTE: You are looping through every cell in Range("B:B") which is probably unnecessary. It'd be better if you use a lastrow value, or a static range like Range("B2:B1000"). Or you could use a criteria to exit your loop like If Cell.Value = "" Then Exit For.
Here's a version of the code that implements the lastrow value that dwirony mentioned in their answer. This also throws everything in arrays, so it might go a bit faster if you have a really large dataset.
Option Explicit
Sub test()
Dim ACol As Variant
Dim BCol As Variant
Dim lastrow As Long
Dim i As Long
lastrow = Range("B:B").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
BCol = Range("B1:B" & lastrow).Value
ACol = Range("A1:A" & lastrow).Value
For i = LBound(BCol) To UBound(BCol)
If IsEmpty(ACol(i, 1)) And Not IsEmpty(BCol(i, 1)) Then
ACol(i, 1) = BCol(i, 1)
End If
Next i
Range("A1:A" & lastrow).Value = ACol
End Sub
I have put together a Macro that allows me to archive Data from one sheet to another however I am having trouble having it Clear the info afterwards. The first Column contains numbers that I do not want to clear, right now it is only clearing the data in column B.
If someone could take a look at this I would be very greatful.
'Sub archive()
Dim i, lastrow
Dim mytext As String
lastrow = Sheets("Rooms").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
mytext = Sheets("Rooms").Cells(i, "F").Text
If InStr(mytext, "yes") Then
Sheets("Rooms").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Rooms").Cells(i, "B").Clear
End If
Next i
End Sub'
I've taken the cell on the associated row in column B and extended it to the last cell on the same row containing any value.
Sub archive()
Dim i, lastrow
Dim mytext As String
With WorkSheets("Rooms")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
mytext = .Cells(i, "F").Text
If InStr(1, mytext, "yes", vbTextCompare) Then
.Cells(i, "A").EntireRow.Copy Destination:=Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
.Range(.Cells(i, "B"), .Cells(i, Columns.Count).End(xlToLeft)).Clear
End If
Next i
End With
End Sub
Additionally, I've used a With ... End With statement to associate WorkSheets("Rooms") with all of its cells to avoid repetitive worksheet referencing.
The Range.Clear command scrubs all values and formatting. If you just want the values to be removed, you may want to switch to Range.ClearContents method.