I have a spreadsheet where column A information starts on row 6 and I have the unique values from this list as headers across the top in Row 1 starting at column D. What I want to do is if a cell in column A matches a header row, copy the information in the cell in column C to the corresponding Header.
ORIGINAL FORMAT
DESIRED FORMAT
Here is the code that I have tried but it is not giving me the desired results:
For i = 6 To lastRow
For j = 4 To lastColumn
If Cells(i, 1) = Cells(1, j) Then
wksActRawData.Cells(i, 3).Value = wksActRawData.Cells(i, j).Value
End If
Next j
Next i
Assuming you did write lastRow and lastColumn functions, the only error in your code is the data which gets the cell values
If Cells(i, 1) = Cells(1, j) Then
wksActRawData.Cells(i, 3).Value = wksActRawData.Cells(i, j).Value
End If
Which should really be the other way around, plus I'd add a line to clear the old prices, as follows
If Cells(i, 1) = Cells(1, j) Then
Cells(i, j).Value = Cells(i, 3).Value
Cells(i, 3).ClearContents
End If
It did work for me this way
Related
I want sheets "Status" and "Ref" compared. If the values match in both columns Status!F and Ref!B AND Status!Q and Ref!C for a particular individual's data in a row, then copy the value from Ref!F to Status!H
This is my first ever attempt at writing code so it's probably full of errors, but the debugger points out the first If statement in particular. I've tried it with and without parentheses.
Sub help()
Dim i As Long
Dim j As Long
Dim index As Integer
Sheet1LastRow = Worksheets("Status").Range("F" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Ref").Range("B" & Rows.Count).End(xlUp).Row
For index = 1 To Sheet1LastRow
If ((Worksheets("Status").Cells(i, 6).Value = Worksheets("Ref").Cells(j, 2).Value) And (Worksheets("Status").Cells(i, 17).Value = Worksheets("Ref").Cells(j, 3).Value)) Then Worksheets("Status").Cells(i, 8).Value = Worksheets("Ref").Cells(j, 6)
Next
index = index + 1
j = j + 1
i = i + 1
Do Until index = Sheet1LastRow
Loop
End Sub
edit - a note--these sheets are not in the same order. so row 1500 in Status could match something on row 3 on ref, for example
Try this
For i = 1 To Sheet1LastRow
For j = 1 To Sheet2LastRow
If ((Worksheets("Status").Cells(i, 6).Value = Worksheets("Ref").Cells(j, 2).Value) and (Worksheets("Status").Cells(i, 17).Value = Worksheets("Ref").Cells(j, 3).Value)) Then
Worksheets("Status").Cells(i, 8).Value = Worksheets("Ref").Cells(j, 6).Value
Exit for
End if
Next j
Next i
I'm trying to create a code that will delete a row if column B has "7:00" and column G has "0". I've been messing with the code below and it appears that the code won't recognize "7:00" in column B (which is formatted as h:mm) unless I enter it as " '7:00". Does this have something to do with the formatting of the time value? Is there a better way to accomplish this?
The code I've been trying:
Dim N As Long, i As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = N To 1 Step -1
If Cells(i, "B") = "7:00" And Cells(i, "G") = "0" Then
Cells(i, "B").EntireRow.Delete
End If
Next i
This should work for you.
If Cells(i, "B").Text = "7:00" And Cells(i, "G").Text = "0" Then
Cells(i, "B").EntireRow.Delete
End If
What I'm trying to do is have the program go through is find a certain value from within a column of cells and see if it matches with one cell after I special paste the value, and if there is a match delete the associated cell and its row of cells. What is happening is that the special pasting part of the program is working, but the associated cells are not being deleted. To clarify, I'm trying to delete a whole row from a certain column based on whether there's a match
Dim j As Integer
Dim i As Integer
i = 2
Dim Aud_Tot As Integer
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial xlPasteValues
For j = 2 To Aud_Tot
If Cells(j, 24).Value = Cells(i, 2).Value Then
Range(Cells(j, 24), (Cells(j, 42))).ClearContents
End If
Next j
i = i + 1
Else
Exit Do
End If
Loop
It seems you want to delete the row but you are only using ClearContents. To delete you can change that line to Range(Cells(j, 24), (Cells(j, 42))).Delete Shift:=xlShiftUp, you can also use xlShiftToLeft.
Did you want to delete the entire row or just the range you have?
Hei,
I need help with Excel. For better undrestanding, picture is attached.
Basically i need excel to go through row by row and copy all rows with set values (see picture).
Logic:
If col1 value "1" copy (always)ยด
incase col3 value "X" copy also row below (value=2)
If col3 not "X" copy and skip to next col1 = 2
If col3 not "X" copy and skip to next col1 = 1
If col1 value "1" copy (always)
incase col3 value not "X" skip to next col1=1
etc.
EDIT:ATTACHED EXCEL FILE WITH EXAMPLE OUTPUT
Excel - Picture
If Sheets(1).Cells(i, 1).Value = 1 Then
//*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 1*//
else if Sheets(1).Cells(i, 1).Value = 1 And Sheets(1).Cells(i, 3).Value = "x" Then
*copy entire row and continue loop*
If Sheets(1).Cells(i, 1).Value = 2 Then
//*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 2 or higer*//
else if Sheets(1).Cells(i, 1).Value = 2 And Sheets(1).Cells(i, 3).Value = "x" Then
*copy entire row and continue loop*
If Sheets(1).Cells(i, 1).Value = 3 Then
//*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 3 or higher*//
else if Sheets(1).Cells(i, 1).Value = 3 And Sheets(1).Cells(i, 3).Value = "x" Then
*copy entire row and continue loop*
If Sheets(1).Cells(i, 1).Value = 4 Then
//*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 4 or higher*//
else if Sheets(1).Cells(i, 1).Value = 4 And Sheets(1).Cells(i, 3).Value = "x" Then
*copy entire row and continue loop*
I have made changes to the code, now it copies data from columns A:E, to add more columns change where it says "5" in Cells(i + 1, 5) or Cells(counter_rows, 5) and add a different column number.
The rows with data are stored in an array to speed up the code and make it more compact.
Also you should put this subroutine in a MODULE in VBA. Don't add code to Sheets.
Sub copy_rows_to_sheet2()
Dim nb_rows As Integer
Dim counter_rows As Integer
Application.ScreenUpdating = False 'speed up code
nb_rows = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'count the number of rows with data on sheet(1)
counter_rows = 2 'the first row on sheet(2) where we start copying data from
Dim Arr() As Variant ' declare an unallocated array, stores data from range on the sheets (any number of rows and columns)
For i = 2 To nb_rows
Sheets(1).Select 'to add data to array, first select the sheet1
If Sheets(1).Cells(i, 1).Value = 1 Or Sheets(1).Cells(i, 1).Value = 2 Then
If Sheets(1).Cells(i, 3).Value = "x" Then 'we copy 2 rows when we have x in col 3
Arr = Range(Cells(i, 1), Cells(i + 1, 5)).Value 'copy all values from row i and next row counter_rows and columns (A to E=5)
Sheets(2).Select 'before the array is pasted to sheet2 first it needs to be selected
Range(Cells(counter_rows, 1), Cells(counter_rows + 1, 5)).Value = Arr
counter_rows = counter_rows + 2 'counter increments by 2 rows
Else
Arr = Range(Cells(i, 1), Cells(i, 5)).Value 'copy row i and 5 columns
Sheets(2).Select
Range(Cells(counter_rows, 1), Cells(counter_rows, 5)).Value = Arr
counter_rows = counter_rows + 1 'counter increments by 1 row
End If
End If
Next i
Application.ScreenUpdating = False 'turn back
End Sub
My code :
For i = 1 To iRowNumber
If Cells(i, x).Value > 1 Then
Cells(i, 2).Copy
Sheets(1).Select
Cells(1, 1).Value = Now
Cells(1, 2).Value = "Duplicate"
Cells(1, 4).Select
ActiveSheet.Paste
Cells(1, 3).Value = Mid(Cells(1, 4), 5, 4)
End If
Next i
x=x+1
Condition :
sheet(2) > 130916001, 130916001000009, 1 '~> check if 3rd column more than 1
expected result :
sheet(1) first row > time , "duplicate", 1600 , 130916001000009
sheet(2) 130916001, 130916001000009, 2 '~> change 1 become 2
result :
sheet(1) fine
sheet(2) 130916001, 130916001000009, not2 '~> error
If i extract this part of code, the counter works fine
Fyi i have 6 sheets, but dunno because of this or not?
Keeping #nutsch suggestions in mind, here is some code with qualified cells, so there's no confusion about which cells belong to which sheet. I'm not exactly sure what you're trying to accomplish, but should be easy enough to make appropriate changes.
Sub copyData()
Dim i As Long, x As Long, iRowNumber As Long
For i = 1 To iRowNumber
If Sheet2.Cells(i, 3) = 1 Then
With Sheet1
.Cells(i, 1).Value = Now() 'time
.Cells(i, 2).Value = "Duplicate"
.Cells(i, 3).Value = Mid(Sheet2.Cells(i, 2), 5, 4)
.Cells(i, 4).Value = Sheet2.Cells(i, 2).Value
End With
Sheet2.Cells(i, 3).Value = 2
End If
Next i
End Sub