Need help here with a macro..
We have at column A all the data starting from A2. What we want to do is create a loop that if column A has value will copy A2 to B2, A3 to B3 and so on. A copy - paste macro wont help us because we filter the data of column A at our existing macro and if we copy and paste it at column B it will not paste the value right next to it.
So we want a loop that scans all column A, finds the non empty and when it finds a value paste it right to the next field. For example A335 to B335 and when it goes to the end of A to stop.
Thank you in advance!
Try this code:
Sub CopyToRight()
Dim rng As Range
Dim LastRow As Long
Dim cell As Variant
LastRow = ActiveSheet.Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:A" & LastRow)
For Each cell In rng
If cell.Value <> "" Then
cell.Offset(0, 1).Value = cell.Value
End If
Next cell
End Sub
Related
So I have a dataset in sheet1, and I need a VBA that will find a specific value in this dataset ("value123"), and then copy the cell directly beneath the cell that has been found (i.e. just one cell, not the whole column), and then paste it in A2 in sheet2.
I have been TRYING to use the offset feature but it's just not working..
Sub Find()
Sheets("Sheet1").Select
Set MyRng = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
For Each cell In MyRng
If cell.Value = "value123" Then
cell.Value = cell.Offset(-1, 0).Value
End If
Next
End Sub
I am trying to compare values from a vlookup to a static value in the column to the left, and then paste the value if it matches.
Column J contain static values
Column K contains a vlookup formula referencing another sheet
I need to loop through column K, and if the value from the vlookup matches the value in the same row in column J, then paste the value into column K.
So if cell J2 = 240.89, and the value of the vlookup in cell K2 = 240.89, then paste the value 240.89 into K2.
So far, the code I have loops through the range but stops at the last pasted value and ignores the vlookup formulas.
Here is the code I have:
Option Explicit
Sub CheckValue()
Dim myRange As Range
Dim cell As Range
Set myRange = Range("K2:K3194")
For Each cell In myRange
If cell.Value = cell.Offset(0, -1) Then
cell.Copy
cell.PasteSpecial xlPasteValues
End If
Next cell
End Sub
Any help is appreciated!
Just for fun another option:
Sub Test()
Dim ws as Worksheet: Set ws = Thisworkbook.Worksheets("Sheet1")
ws.Range("K2:K3194").Value = ws.Evaluate("IF(K2:K3194=J2:J3194,J2:J3194,FORMULATEXT(K2:K3194))")
End Sub
Note: This requires FORMULATEXT, a function available since Excel2013.
Try
For Each cell In myRange
If cell.Value2 = cell.Offset(0, -1).Value2 Then
cell.value = cell.value
End If
Next cell
or maybe use a WorksheetFunction.Round to match the values to a specific precision. I feel like this is more the issue than anything.
In column A there are 24 titles. In column B there is similar data.
I want a "Private Sub CommandButton3_Click()" to clear contents from cell B1 in which text does not equal cell A1. Same for all lines down the table.
You can use for each loop to do the job.
Private Sub CommandButton3_Click()
Dim range As range
Set range = Worksheets("Sheet1").range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each cell In range
If cell.Value = cell.Offset(0, -1) Then
cell.ClearContents
End If
Next cell
End Sub
Have data set in I11:X11 and I want to copy formulas seating I12:I12 into I13:X20 based on data contained in I11:X11.
Starting with I11, if that contains certain value lets say TEST, then want to increment row for that range to next column that is J11 and if J11 <> TEST, then copy J12:X12 to J13:X20.
Further want to skip pasting this entire logic based on flag seating in column H13:H20, for example if H13 = Y, then skip to next row.
Adding a screenshot to further explaining the issue.
Condition should start with first member in range I11:X11, if it encounters first member <> TEST till T11 , then it should start copying from that range. In this case it encountered first <> TEST member at L11, then it should copy from L12:T12 to L13:T24 and V12:X12 to V13:X13. Further this logic should work on the flag contained in column H. If this column H Contains Y,then above logic should not paste in that row, this pasting activity should go on until last value in column H starting from H13.
The condition value from I11:T11 can change between TEST and any other values, not further.
Want to achieve this on a button click using a VBA code.
Adding Code, but it limits to the fixed column H values and Fixed row values.
Sub CopyOnCondition1()
Dim sh1 As Worksheet, c As Range
Set sh1 = Worksheets("SheetNameHere") 'change the sheetname
For Each cel In sh1.Range("I11:T11")
If Not cel.Value = "TEST" Then
sh1.Range(Cells(12, cel.Column), Cells(12, 20)).Copy
sh1.Range(Cells(13, cel.Column), Cells(24, 20)).PasteSpecial xlPasteFormulas
End If
Next
For Each cel In sh1.Range("H13:H24")
If cel.Value = "Y" Then sh1.Range("I" & cel.row & ":T" & cel.row).ClearContents
Next
End Sub
enter image description here
As I could understand from the Question I think you are looking for something like this:
Sub CopyOnCondition1()
Dim sh1 As Worksheet, c As Range
Set sh1 = Worksheets("SheetNameHere") 'change the sheetname
For Each cel In sh1.Range("I11:T11")
If Not cel.Value = "TEST" Then
sh1.Range(Cells(12, cel.Column), Cells(12, 20)).Copy
sh1.Range(Cells(13, cel.Column), Cells(24, 20)).PasteSpecial xlPasteFormulas
End If
Next
For Each cel In sh1.Range("H13:H24")
If cel.Value = "Y" Then sh1.Range("I" & cel.row & ":T" & cel.row).ClearContents
Next
End Sub
First It will paste in the complete Range. Then it wo go and check if H have Y, if yes, then it will delete the formula from that row.
Please see below code I have found on the internet, which is currently working to a certain degree for me.
Could someone possibly commentate on what each line of this code means so I can understand what its doing?
Im trying to understand it with little programming knowledge and add additional code to look for additional values to paste into additional sheets.
I'm also trying to work out how to make them paste to certain rows one after the other and not maintain the row they were originally in on sheet 1.
Code:
Sub Test()
Dim rw As Long, Cell As Range
For Each Cell In Sheets(1).Range("H:H")
rw = Cell.Row
If Cell.Value = "Dept 1" Then
Cell.EntireRow.Copy
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
End If
Next
End Sub
--
Many thanks
I've added comments as requested. To paste them onto the same row, look at removing the rw variable and replacing it with something that increments by one each time
Sub Test()
'declare variables
Dim rw As Long, Cell As Range
'loop through each cell the whole of column H in the first worksheet in the active workbook
For Each Cell In Sheets(1).Range("H:H")
'set rw variable equal to the row number of the Cell variable, which changes with each iteration of the For loop above
rw = Cell.Row
'check if the value of Cell variable equals Dept 1
If Cell.Value = "Dept 1" Then
'copy the entire row if above is true
Cell.EntireRow.Copy
'paste to the same row of Sheet 2
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
End If
Next
End Sub
Here is your Code Commented hope you understand:
Sub Test()
' Variables Defined as follows:
Dim rw As Long, Cell As Range
' Loop Searching each Cell of (Range H1 to end of last H on sheet1
For Each Cell In Sheets(1).Range("H:H")
' now determine current row number:
rw = Cell.Row
' Test cell value if it contain >> Dept 1 as value:
If Cell.Value = "Dept 1" Then
' Select that row and copy it:
Cell.EntireRow.Copy
' now paste the values of that row into A column and rw row on sheet2:
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
' You should add following to:
' Disable marching ants around copied range:
Application.CutCopyMode = False
End If
Next
End Sub