If a row contains the value "car" I am trying to copy the contents of the ID cell to A1.
For example, if row D12 contains "car" I want to copy the contents of cell B12 to A12.
Currently this is my code:
Dim lastRow As Long
Dim cell As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
For Each cell In Range("D2:D" & lastRow)
If InStr(1, cell.Value, "CAR") <> 0 Then
cell.Offset(0, -3).Value = "test"
End If
Next
So currently the code find's the rows that has "car" but populates the cell with the value "test". I am struggling with how to reference/copy the cell over.
This is because the first column of my worksheet requires a concatenation of values as the ID and I do not want to apply it to this string.
Thanks for any advice/help!
The reason you get "test" as inserted in to column A is, that is what the code is specifying. The code needs to be changed to reflect what is wanted.
If the contents of column B is wanted, then replace the string "test" with:
cell.Offset(0, -2).Value
So the whole line would read:
cell.Offset(0, -3).Value = cell.Offset(0, -2).Value
Since you are iterating through column D, cell is located in column D. The offset part is saying, "Move over three places from column D and place the value from two columns over". Or column A on the same row, which is 3 cells to the left from the current cell in column D and place the value from Column B on the same row, which is 2 cells to the left of the current cell in column D.
Another quick way would be to use the autifilter.
For example:
Sub Button1_Click()
Dim lastRow As Long
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = 0
lastRow = Range("D" & Rows.Count).End(xlUp).Row + 1
Columns("D:D").AutoFilter Field:=1, Criteria1:="=*Car*"
Set rng1 = Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
Set rng2 = Range("B2:B" & lastRow).SpecialCells(xlCellTypeVisible)
rng1.Value = rng2.Value
ActiveSheet.AutoFilterMode = 0
End Sub
Related
Ok... I am struggling with something that is probably simple... I have a formula in cell B2 and I want to fill to the last cell that contains data or formatting (same as when you press CTRL+END) or in other words "the bottom right corner" of my data. How do I do this? There is data in column "A" and in row "1"... So it needs to fill to the last row and last column containing data...
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("B2").AutoFill Destination:=Range(Range("B2"), Cells(2, lastCol)), Type:=xlFillDefault
Range("B2:B" & lastCol).AutoFill Destination:=Range("B2"), Cells(lastRow, lastCol)), Type:=xlFillDefault
The below code helps you determine, and reference, your "box range." The code is making 3 assumptions that you may need to amend for if incorrect:
1) The "top left corner" of your box range is B2
2) Values in Col B span to the bottom of your range. If you expect blanks in Col B, change this to a different column.
3) Values in row 2 span to the end of your used columns. If you expect blanks in row 2, change this to a different row.
Sub RangeBox()
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets(1)
Dim LRow As Long
Dim LCol As Long
LRow = WS.Range("B" & WS.Rows.Count).End(xlUp).Row
LCol = WS.Cells(2, Columns.Count).End(xlToLeft).Column
MsgBox "Last Row: " & LRow & vbNewLine & "Last Column: " & LCol
'How to refer to the box range starting from A1
Dim Start As Range
Set Start = WS.Range("B2")
WS.Range(Start, WS.Cells(LRow, LCol)).Select
End Sub
To fill this range with a formula:
WS.Range(Start, WS.Cells(LRow, LCol)).Formula = "=Sum(1,2)"
Inside the quotes, type the equation in as you would in excel and used locked references if needed ($). The above example would fill your range with the value 3.
I have a macro right now that pulls data from a different sheet into a new sheet, then formats the data into a form I can use. The issue I have is that some of the PNs that I pull from the other sheet are in different cells for ease of viewing. (For example, the top level PN is in cell C2 and any parts that are a part of the part in C2 may be listed in D3, to show it's a sub-part).
I need code that will shift all PNs across varying columns into a single column. Once all PNs are moved, the other columns should be deleted (D through F). The data ranges from column C to F. Depending on the table the macro pulls data from, the length of the data varies. The macro will need to be able to handle this.
Here's an example of what my sheet looks like after my macro runs:
I'm trying to check column C for empty rows. If say C3 is empty, I then want to check D3 for text. If there is text, I want text in D3 to move to C3. If there is no text, check E3. Same process repeated. From what I've found online, I have this code so far (however, it doesn't run properly in my macro)...
'Copy PNs that are out of line and paste them in the correct column
Dim N As Long, i As Long, j As Long
Set ws1 = Worksheets("KDLSA")
N = ws1.Cells(Rows.Count, "C").End(xlUp).Row
j = 4
For Each cell In Range("D2:F" & ws1.Cells(Rows.Count, "F").End(xlUp).Row)
If cell.Value = "" Then 'if cell C is blank, I want to shift the text to fill column C
ws1.Range("C" & j).Value = ws1.Range("D" & cell.Row).Value 'copy PN in column E to column D - this needs to be more robust to cover my range of columns rather than just D and E
j = j + 1
End If
Next cell
Any help is appreciated.
Change your "For" block to:
With ws1.UsedRange
lastRow = .Rows(.Rows.Count).Row
End With
For Each cell In Range("C2:C" & lastRow)
If cell.Value = "" Then
thisRow = cell.Row
For Each horCell In Range(Cells(thisRow, "D"), Cells(thisRow, "F"))
If Not horCell.Value = "" Then
cell.Value = horCell.Value
Exit For
End If
Next horCell
End If
Next cell
Range("D:F").EntireColumn.Delete
By cycling only through column C, you can loop through D-F only if C is blank, and when you find the one with data, it puts it in C.
If you also need dynamic range on the number of columns, then do:
With ws1.UsedRange
lastRow = .Rows(.Rows.Count).Row
lastColumn = .Columns(.Columns.Count).Column
End With
For Each cell In Range("C2:C" & lastRow)
If cell.Value = "" Then
thisRow = cell.Row
For Each horCell In Range(Cells(thisRow, "D"), Cells(thisRow, lastColumn))
If Not horCell.Value = "" Then
cell.Value = horCell.Value
Exit For
End If
Next horCell
End If
Next cell
Range(Cells(2, "D"), Cells(2, lastColumn)).EntireColumn.Delete
Or with a correct lastRow in your for loop "to" range, change your code to
If Not cell = "" then
ws1.range ("C" & cell.Row).Value = cell.Value
End if
You are looping through columns D-F, so "cell" is a cell in that range, not in column C. You therefore want to test for the ones that are NOT empty and then put their values in the corresponding cell in column C. :-)
As Tehscript mentioned you dont need a macro. If you nevertheless want to use a macro (maybe your real case is more complex than the example) here is a starting point for you.
The example below will shift the cells only once. So you might want to execute the loop several times. (You could also loop over the rowIndex and use a while loop for each row.)
The code could be further refactored but I hope this way it is easy to read.
Sub ShiftCells()
Dim myWorkSheet As Worksheet
Set myWorkSheet = Worksheets("Tabelle1")
Dim maxRowIndex As Long
maxRowIndex = GetMaxRowIndex(myWorkSheet)
Dim rowIndex As Long
Dim columnIndex As Long
Dim leftCell As Range
Dim rightCell As Range
For Each Cell In Range("C2:F" & maxRowIndex)
If Cell.Value = "" Then
shiftedCell = True
rowIndex = Cell.Row
columnIndex = Cell.Column
Set leftCell = myWorkSheet.Cells(rowIndex, columnIndex)
Set rightCell = myWorkSheet.Cells(rowIndex, columnIndex + 1)
leftCell.Value = rightCell.Value
rightCell.Value = ""
End If
Next Cell
End Sub
Function GetMaxRowIndex(ByVal myWorkSheet As Worksheet) As Long
Dim numberofRowsInColumnC As Long
numberofRowsInColumnC = myWorkSheet.Cells(Rows.Count, "C").End(xlUp).Row
Dim numberofRowsInColumnD As Long
numberofRowsInColumnD = myWorkSheet.Cells(Rows.Count, "D").End(xlUp).Row
Dim numberofRowsInColumnE As Long
numberofRowsInColumnE = myWorkSheet.Cells(Rows.Count, "E").End(xlUp).Row
Dim numberofRowsInColumnF As Long
numberofRowsInColumnF = myWorkSheet.Cells(Rows.Count, "F").End(xlUp).Row
Dim maxNumberOfRows As Long
maxNumberOfRows = WorksheetFunction.Max(numberofRowsInColumnC, _
numberofRowsInColumnD, _
numberofRowsInColumnE, _
numberofRowsInColumnF _
)
GetMaxRowIndex = maxNumberOfRows
End Function
My first sheet is set up like this:
I want to find the non zero values in column G. Then I want to read the corresponding name in column C. I, then, want to return the value of the name to a cell on Sheet 2.
At this point, it doesn't matter what cell it returns to in sheet 2. It sounds like a VLOOKUP or INDEXMATCH but my VBA isn't good enough to figure out the formatting of it. This is some code that I tried and I can get it to return the name. But I don't know how to do it for all non zeros or how to have it print to sheet 2. Need a loop or need to figure out look ups!
code:
For Each c In Range("G6").Cells
If c.Value > 0 Then
PlayerName = Range(Cells(Selection.Row, 3).Address).Value
End If
Exit For
Next c
The following code will find the first row which has a number greater than 0 in column G (starting at row 6), and write the value in column C of that row to cell X5 of Sheet2.
With Worksheets("Sheet1")
For Each c In .Range("G6", .Cells(.Rows.Count, "G").End(xlUp)).Cells
If c.Value > 0 Then
Worksheets("Sheet2").Cells(5, "X").Value = c.Offset(0, -4).Value
Exit For ' Moved this inside the `If`, otherwise it will exit as soon as
' the first cell in the range is processed, irrespective of whether
' it was greater than 0 or not
End If
Next c
End With
Iterative version:
Dim s2Row as Long
s2Row = 5
With Worksheets("Sheet1")
For Each c In .Range("G6", .Cells(.Rows.Count, "G").End(xlUp)).Cells
If c.Value > 0 Then
Worksheets("Sheet2").Cells(s2Row, "X").Value = c.Offset(0, -4).Value
s2Row = s2Row + 1
End If
Next c
End With
Here is the logic you'll need. Will you be able to build the macro with this logic? It will help you understand how to maneuver rows that are greater than zero. Then you copy the column on that row y9ou need and paste it to the other sheet.
Sub macro1()
Dim myRng As Range, lastRow As Long
lastRow = ActiveSheet.Range("G65536").End(xlUp).Row
Set myRng = Sheet1.Range("G1:G" & lastRow)
For Each Rng In myRng
If IsNumeric(Rng.Value) And Rng.Value > 0 Then
Debug.Print "Cell " & Rng.Address & " has the number " & Rng.Value & " in row " & Rng.Row
End If
Next Rng
End Sub
Yes, except "G" is a column, not a row. Replace the debug.print line with WorkSheets("sheet name to copy from here").Rows(rng.row).Copy Destination:=WorkSheets("sheet name to copy to here").Range("A" & rowCounterVariable). Of course, change the sheet names to your actual sheet names.
Here I set the first row at 2 on the page to copy to. If you need to set it to the first available row then you need to research how to find the last used row on that page. Put these exact terms into Google "VBA EXCEL HOW TO FIND LAST USED ROW". I have an example of finding the last used row for the activesheet inside the code. We could give you fish today, and teach you how to fish. But you need to catch your own. We're not here to write code for you.
Sub macro2()
Dim myRng As Range, lastRow As Long, rowCounterVariable as long
rowCounterVariable = 2
lastRow = ActiveSheet.Range("G65536").End(xlUp).Row
Set myRng = Sheet1.Range("G1:G" & lastRow)
For Each Rng In myRng
If IsNumeric(Rng.Value) And Rng.Value > 0 Then
WorkSheets("sheet name to copy from here").Rows(rng.row).Copy Destination:=WorkSheets("sheet name to copy to here").Range("A" & rowCounterVariable)
rowCounterVariable = rowCounterVariable + 1
End If
Next Rng
End Sub
I would like to start at cell A2 and then select every 6th cell in that column. Next, I want to insert a cell and shift everything to the right.
This is what I have that works so far, but it's long and takes forever to type out:
Range("A2,A8,A14,A20,A26,A32,A38,A44,A50,A56,A62,A68,A74").Select
Selection.Insert Shift:=xlToRight
Please tell me there is a more simple expression to get the desired output.
Thanks.
do it in a loop so you don't have to type it all out.
for i = 2 to 10000 step 6
range("A" & i).Select
Selection.Insert Shift:=xlToRight
next
you don't have to do the select, you can also do range("A"&i).insert Shift:=xlToRight
You can use Union Function to set the range and then move all cells together.
Sub Demo()
Dim rng As Range
Dim lastRow As Long
'get last row in column "A"
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
'set range using Union function
For i = 2 To lastRow Step 6
If rng Is Nothing Then Set rng = Range("A" & i)
Set rng = Union(Range("A" & i), rng)
Next
'move range to right
rng.Insert Shift:=xlToRight
End Sub
you could go like follows:
For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlNumbers)
If (cell.Row - 2) Mod 6 = 0 Then cell.Insert Shift:=xlToRight
Next cell
but should your need be not actually shifting cells (i.e. shifting ALL row cells at the right of the relevant one) but rather their values only then you could go like follows:
For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
If (cell.Row - 2) Mod 6 = 0 Then cell.Offset(, 1) = cell: cell.ClearContents
Next cell
which is much faster
a few words about what you see in code above:
the Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) part takes care to consider only column "A" cells from "A1" down to its LAST non empty one
the .SpecialCells(xlCellTypeConstants) part takes care to furtherly filter the former range considering only cells with a "constant" (i.e. not resulting from a formula) value in it
you could even be more specific like
SpecialCells(xlCellTypeConstants, xlTextValues)
which would consider only "constants" (as above defined) string values
SpecialCells(xlCellTypeConstants, xlNumbers)
which would consider only "constants" (as above defined) numeric values
the same can be achieved for cell with formulas only just by typing xlCellTypeFormulas instead of xlCellTypeConstants
How can I find the last row in a range of cells that hold a formula, where the result of the formula is an actual value and not empty?
Say in a simplified way that the range of cells ("E1:E10") hold a formula referring to cells A1 through A10 as followed =IF("A1"="","","A1"). But only the cells A1 through A6 have a value filled in, so the result of the formula for cells E7 through E10 will be empty.
Trying to do it with:
lastRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
results in lastRow having the value of 10. What I want is for the value of lastRow to be 6 in this example.
The actual code is way more complex than this so I can't just check for the last filled in Row of Column A, as the formulas refer to single cells on different sheets and are added dynamically.
I think that more elegant way than was provided by #D_Bester is to use find() option without looping through the range of cells:
Sub test()
Dim cl As Range, i&
Set cl = Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
i = cl.Find("*", , xlValues, , xlByRows, xlPrevious).Row
Debug.Print "Last row with data: " & i
End Sub
test
Also, more shorter version of the code which was provided above is:
Sub test2()
Debug.Print [E:E].Find("*", , xlValues, , xlByRows, xlPrevious).Row
End Sub
You want to find the last cell in a column that is not empty AND is not a blank string("").
Just follow the LastRow with a loop checking for a non-blank cell.
lastrow = ActiveSheet.Range("E" & ActiveSheet.Rows.Count).End(xlUp).Row
Do
If ActiveSheet.Cells(lastrow, 5).Value <> "" Then
Exit Do
End If
lastrow = lastrow - 1
Loop While lastrow > 0
If lastrow > 0 Then
Debug.Print "Last row with data: " & lastrow
Else
Debug.Print "No data in the column"
End If
Notice that your Rows.count does not specify which sheet. That means it will use the active sheet. Of course ActiveSheet.Range() also is on the active sheet. But it is bad practice to mix Range or Rows with .Range or .Rows. It indicates a thoughtless usage that could bite you if you changed the ActiveSheet but didn't change the unspecified reference.
This should help you determine the last row containing a formula (in column A on sheet1 Sheet1):
lastRow = Split(Split(Sheet1.Range("A:A").SpecialCells(xlCellTypeFormulas).Address, ",")(UBound(Split(Sheet1.Range("A:A").SpecialCells(xlCellTypeFormulas).Address, ","))), "$")(2)
SpecialCells is used to determine the range of all the cells containing a formula. This range is then parsed using Split. With Ubound the last of these cells is being retrieved. The result is being split again to extract the row number.
Function returnLastRow()
With ActiveSheet.UsedRange
returnLastRow = .Find("*", , xlValues, , xlByRows, xlPrevious).Row
End With
End Function