Here is my code:
For j = 3 To 37 Step 2
If PaddleBDateInstalledTextBox.Value = Cells(j, 8).Value Then
Cells(j, 8).Copy
Range("D42").PasteSpecial Paste:=xlPasteValues
Range("D42").PasteSpecial Paste:=xlPasteFormats
Range("D42").PasteSpecial Paste:=xlPasteAllUsingSourceTheme '<--
cells background, etc.
Range("D42").NumberFormat = "MM/DD/YY"
Cells(j, 8).Clear
End If
Next
I have one cell where the format is a date and I am trying to copy it first and then paste it into another cell but my cell did not have the value pasted in it and the original cell; and the contents were not cleared.
I have another cell that has the format Today() and I want to just copy the value without the formula into another cell but i have failed as well.
The last cell that I want to copy has a formula of =($I$2-H2)+(G2-F2) and I have the same problem.
This code worked for me:
If 1 = Cells(1, 1).Value Then 'Assuming in Cell(1, 1) is the value 1
Cells(1, 1).Copy
Range("B1").PasteSpecial Paste:=xlPasteValues
Range("B1").PasteSpecial Paste:=xlPasteFormats
Range("B1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Range("B1").NumberFormat = "MM/DD/YY"
Cells(1, 1).Clear
End If
Maybe the Cells(j, 8).Value is your problem. What value does j have? If j is a variable your code should be right, but if you mean J as column name the code should be Range("J" & 8).Value or Cells(8, "J").Value instead of Cells(j, 8).Value
Related
I have three sheet, Sheet1 , sheet2, and sheet3.
Sheet3 is my result sheet.
I have the ID in column E of sheet3, copied from Column P of sheet1. I compare the ID of sheet3, with ID of sheet2. I am successful.
but, i have an issue while comparing. The ID are generally 11 to 13 Digit Long.
Case1, in few cases i have id in sheet 3 as D2C12682300 and in sheet2 the same ID as D2C1268230000, in this case, i want them to be matched, but according to my code, it is not getting matched.
Case2, in somecase i have the id in sheet3 as D2C12682300_id4576901 and in the sheet2 i have the same id as D2C1268230000. I want them to be matched, but my code is not working this way.
Could someone suggest, how i could include These condition in my code.I am struck how to do it.
Below is the code, i am using to look for id from sheet3 to sheet2. I want to include These cases in this code.
Sub lookup()
Dim lLastRow As Long
Dim rng As Range
Dim i As Long
'Copy lookup values from sheet1 to sheet3
ThisWorkbook.Sheets("S").Select
lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
Range("P5:P" & lLastRow).Copy Destination:=Sheets("Result").Range("E5")
Range("G5:G" & lLastRow).Copy Destination:=Sheets("Result").Range("H5")
'Go to the destination sheet
Sheets("Result_").Select
For i = 5 To lLastRow
'Search for the value on sheet2
Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
Cells(i, 6).Value = rng.Value
Cells(i, 1).Value = rng.Offset(0, 1).Value
Cells(i, 2).Value = rng.Offset(0, 2).Value
Cells(i, 3).Value = rng.Offset(0, 3).Value
Cells(i, 4).Value = rng.Offset(0, 9).Value
Cells(i, 9).Value = rng.Offset(0, 10).Value
Cells(i, 12).Value = rng.Offset(0, 6).Value
Cells(i, 13).Value = rng.Offset(0, 5).Value
Cells(i, 14).Value = rng.Offset(0, 8).Value
End If
Next i
End Sub
Use a Wildcard:
Set rng = Sheets("P").UsedRange.Find(Cells(i, 5).Value & "*", LookAt:=xlWhole)
Also avoid using .Select and objectify .Range, .Cells etc. Read How to Avoid Select.
I have a matrix of rows and columns with data as string not integer. I have a reference cell which I want to compare with the a particular cell in each row. I have the following code.
`Worksheets("Sheet2").Activate
With Sheets("Sheet1")
str2 = Cells(1, 14).Value
For j = 1 To .Cells(.Rows.Count, 2).End(xlUp).Row
str1 = Cells(j, 2).Value
result = StrComp(str1, str2, vbBinaryCompare)
If result = 0 Then
.Range(.Cells(j, 1), .Cells(j, 12)).Copy
ActiveSheet.Cells(2, 14).PasteSpecial Transpose:=True
End If
Next j
End With`
The problem is it is telling me that every comparison is true. Where am I going wrong?
This is part of my script, easy loop copying some rows from one sheet to another:
a = 3
With Sheets("ATD")
Do While .Range("A" & a) <> ""
If .Cells(a, 6).Value = "x" And .Cells(a, 8).Value = "y" Then
.Range(Cells(a, 1), Cells(a, 10)).Copy
Sheets("ART").Range("A" & Sheets("ART").Range("A" & Rows.Count).End(xlUp).row + 1).PasteSpecial xlPasteValues
End If
a = a + 1
Loop
End With
It fails almost every time on .Range(Cells(a, 1), Cells(a, 10)).Copy line (Run-time error '1004': Application-defined or object-defined error). When I add .Select command like this:
a = 3
With Sheets("ATD")
Do While .Range("A" & a) <> ""
If .Cells(a, 6).Value = "x" And .Cells(a, 8).Value = "y" Then
.Select
.Range(Cells(a, 1), Cells(a, 10)).Copy
Sheets("ART").Range("A" & Sheets("ART").Range("A" & Rows.Count).End(xlUp).row + 1).PasteSpecial xlPasteValues
End If
a = a + 1
Loop
End With
everything works fine.
I know I can change .Copy on something like
Sheets("ATD").Range(Cells(a, 1), Cells(a, 10)).Value = Sheets("ART").Range(Cells(b, 1), Cells(b, 10)).Value
but I have another question. If .Copy function require, that cells I want to copy are in currently selected sheet, or am I missing something here?
Can you try with:
.Range(.Cells(a, 1), .Cells(a, 10)).Copy
The points are really important, as they reference the current Cells with the Sheet Object set in the With Sheets("ATD") line.
I have been trying to create a vba code to rebuild a table with the information fed into it. What the code should do is the following:
Look in column G for the first none empty and non 0 cell and copy that value to the first #N/A in column C. Finally recalculate row for the first cell found in column C.This is the code I have.
i = 3
For i = 3 To 79
If Cells(i, 7).Value > 0 And Cells(i, 7).Value <> "" Then
MovingValue = Cells(i, 7).Value
Cells(i, 7).Copy
j = 3
For j = 3 To 4
If Cells(j, 3).Text = "#N/A" Then Exit For
Cells(j, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Cells(i, 3).FormulaLocal = "=VLOOKUP(B" & (i) & ";'Cleaning step 2'!B:C;2;0)-" & MovingValue
Next j
End If
Next i
What I can't get it to do is, jump out of the code after it has completed this cylce an redo it for a new run. Recheck column G for first non empty and non 0. etc.
Can anyone help me?
I have an Excel spreadsheet with answers to questions for an exam. It is set up as a series of 4x2 blocks. Each block has the 4 multiple choice answers in the first column, and then a 0 or a 1 in the column to the right indicating correct or incorrect.
I want to make a macro to take the 2nd, 3rd, and 4th answer and corresponding 0/1 cell and paste them so they end up to the right of the 1st answer in the block. I have this macro so far, which successfully edits the first answer and correctness indicator column:
Range("A2:B2").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("A3:B3").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
Range("A4:B4").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste
How can I change it so that it will do cells 2, 3, 4, 6, 7, 8, 10, 11, 12, etc. but skip 1, 5, 9, etc.?
Thanks!
Given an input of:
Using code:
Sub QReform()
Dim CurRow As Long, LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For CurRow = LastRow To 1 Step -1
If ((CurRow - 1) / 5) - ((CurRow - 1) \ 5) = 0 Then
Cells(CurRow, 2).Value = Cells(CurRow, 1).Offset(1, 0).Value
Cells(CurRow, 3).Value = Cells(CurRow, 1).Offset(1, 1).Value
Cells(CurRow, 4).Value = Cells(CurRow, 1).Offset(2, 0).Value
Cells(CurRow, 5).Value = Cells(CurRow, 1).Offset(2, 1).Value
Cells(CurRow, 6).Value = Cells(CurRow, 1).Offset(3, 0).Value
Cells(CurRow, 7).Value = Cells(CurRow, 1).Offset(3, 1).Value
Cells(CurRow, 8).Value = Cells(CurRow, 1).Offset(4, 0).Value
Cells(CurRow, 9).Value = Cells(CurRow, 1).Offset(4, 1).Value
Cells(CurRow, 1).Offset(4, 0).EntireRow.Delete xlShiftUp
Cells(CurRow, 1).Offset(3, 0).EntireRow.Delete xlShiftUp
Cells(CurRow, 1).Offset(2, 0).EntireRow.Delete xlShiftUp
Cells(CurRow, 1).Offset(1, 0).EntireRow.Delete xlShiftUp
End If
Next CurRow
End Sub
Will give you this:
I ended up moving the columns into a text editor and using regex to do the work, as that was a much simpler way of doing it. I searched for blocks of 4 lines and replaced returns with tabs where appropriate so it would fit on one line and go back into Excel easily.