I am trying to write a snippet of code to run through multiple worksheets and, if the value in column "h" is not empty, copy each sheet row-by-row to a master summary sheet. My problem is that every cell in column "h" contains a CONCATENATE formula, but of course if the rest of the row is empty then the CONCATENATE returns an empty or 0 value. For some reason the following code is failing to ignore these rows. (Note: w is the object representing the current worksheet, and dest is the object representing the destination worksheet where rows will be copied to.)
Last = w.Cells(Rows.Count, "h").End(xlUp).Row
For a = 2 To Last Step 1
If w.Cells(a, "h").Text <> "" Or w.Cells(a, "h").Text <> "0" Then
d = dest.Cells(Rows.Count, "h").End(xlUp).Row + 1
w.Cells(a, "h").EntireRow.Copy dest.Cells(d, 1)
End If
Try If w.Cells(a, "h").value <> ""
Related
I am trying to copy and paste data from the same column (A) in multiple sheets into a single column of a data in a final sheet.
The code I have used so far works perfectly if there is more than one row of data beneath the header row.
The sheet is formatted to include a table beneath the data and if there is only one row of data on the sheet the existing code will copy data from cell A2 to the first cell in the table with data (essentially performing ctrl+shift+down).
I need an if statement to count a range of data (could be A2:A3) and if the count is greater than 1 it would copy all the data down the column to first empty row. Then paste it to the first empty row in Column A of another sheet. Else copy cell A2 and then paste it to the first empty row in column A of another sheet.
Sheets("Sheet1").Select
If Range("A2:A3").Count > 1 Then
Range("A2",Range("A2").End(xlDown)).Copy Destination:=Sheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
ElseIf Range("A2:A3").Count = 1 Then
Range("A2").Copy Destination:=Sheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
This will work. You really just need to check if A3 has data.
With Worksheets("Sheet1")
Dim source as Range
If Len(.Range("A3")) then
Set source = .Range(.Range("A2"),.Range("A2").End(xlDown))
Else
Set source = .Range("A2")
End If
End With
Dim dest as Range
Set dest = Worksheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
dest.Resize(source.Rows.Count,1).Value = source.Value
I have a column that contains 50 rows of text. I want to copy each cell and paste its value in a different column, but do so X amount of times based on a separate input. My mind defaults to thinking pythonically, and I want to append each item to a list for manipulation, though I don't think that is necessary in this instance.
Sub fipsloop()
finalRow = Cells(Rows.Count, "P").End(xlUp).Row
p = Worksheets("StateSource").Range("B3:").Select
p_count = WorksheetFunction.CountA(p)
Dim rng As Range, cell As Range
rng = Range("e3:finalRow")
For Each cell In rng
If x.Value = "" Then
Exit For
If p_count > 1 Then
'# here is where I am stuck.
Next cell
"p_count" is the number of times I want to paste each cell's contents into a different column. So if there are 50 items in column E, and my "p_count" variable is 2, then I will paste each item twice and will have 100 items in my new column.
In python I would append each item X amount of times to a list. Is there a way to do something like that within VBA?
Just use the .Value property in your loop. This will copy the value from column 5/E into cells in column 16/P very quickly:
For rowIndex = 1 to p_count
Worksheets("StateSource").cells(rowIndex, 16).Value = Worksheets("StateSource").cells(rowIndex, 5).Value
Next
This process is being used for QC purposes. I have a spreadsheet that highlights certain cells that are wrong based off of their values and the validation rules we have in place. I was wonder if there was a way to return the column names of each cell that is colored into column A for each row? So for example if D2, F2, and G2 are wrong it would put all of those column headers in A2 to specify what exactly is wrong. I know it gets a bit more complicated trying to automate stuff with cell colors and I am not experienced in VBA which I'm assuming this will need. Is this possible to do, if so what would be the proper route to take? The data runs from column A to column BS, and the row numbers may differ, so if it could run up to row 1,000 that would be great. Attached is what the data looks like that I am working with.
The red means something is wrong in that row, and the orange cell is the color indicating that it is a wrong value
Yes, it is possible to do. Here is some snippets of code I pulled together to help get you started.
Lastrow = Cells(Rows.count, "A").End(xlUp).Row 'Get last row
With ActiveSheet
Lastcol = .Cells(1, .Columns.count).End(xlToLeft).Column 'Get last col
End With
For x = 1 To Lastcol 'Iterate Col
For i = 1 To Lastrow 'Iterate Row
'if red....
If Cells(i, x).Selection.Interior.Color = 255 then
'Move name to Cell A and append off of old name(s).
Cells(i, "A") = Cells(i, "A") & ", " & Cells(i, x)
End If
Next i 'next row
Next x 'next col
I currently have a code that finds the first empty cell in a specific column and saves the result of a "SumIfs" calculation into that cell. It runs for multiple columns on multiple criteria. The example below is one instance where I search for the criteria "R" and "ECHO", sum the corresponding values from column 16, and place the result in column "C" of another worksheet:
Sub SumIfs()
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("previous_day_split")
Worksheets("daily_balance").Activate
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Application.SumIfs(ws2.Columns(16), ws2.Columns(15), "R", ws2.Columns(20), "ECHO")
End Sub
It works great, but now instead of just placing the result in the first empty cell of column "C", I want to find a way to designate a row (not always going to be the first empty one) based on specific dates in the first column of "daily_balance".
In short, for example, I want the code to essentially search for a date (say 11/2/2015) in the first column of the worksheet "daily_balance", designate that row as the row to dump the values into, run the SumIfs function in "ws2", and place the results in column "C" for the row containing 11/2/2015.
Any suggestions or ideas on the best way to designate a row based on criteria?
You can easily look for a specific value in a column using Do While loop:
i = 0
Do While Cells(i, "A") <> {lookup_value} And Cells(i, "A") <> ""
i = i + 1
loop
'Check that {i} holds row number for our lookup value and not for an empty one
if Cells(i, "A") = {lookup_value} then
'Do your calculations here
'And then use {i} as row number to save your result.
end if
So {lookup_value} is a constant or variable holding the date you are looking for. In case your dates are not well formated you might need to use CDate() to bring your lookup_value and cell value to the same format, meaning that instead of:
Do While Cells(i, "A") <> {lookup_value} And Cells(i, "A") <> ""
you should use:
Do While CDate(Cells(i, "A")) <> CDate({lookup_value}) And Cells(i, "A") <> ""
Good luck with that, and feel free to ask for more details.
I need to copy a row of data onto another sheet based on a value in that row. The value is 0 and will always be found in Column J of the origin sheet. I want columns A - N copied to the second sheet. I found this script which copies the entire row. The problem is I need to preserve any data that was previously entered onto the second (destination) sheet in columns O - AZ. Unfortunately, the script below pastes the entire row to the second (destination) sheet and any data that was entered in columns O - AZ is lost.
Sub MyMacro()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("0", ",")
For Each Cell In Sheets("AMI").Range("J:J")
If Len(Cell.Value) <> 0 Then
For i = 0 To UBound(aTokens)
If InStr(1, Cell.Value, aTokens(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("AMI").Rows(Cell.Row).Copy Sheets("AMI Fallout").Rows(iMatches + 1)
End If
Next
End If
Next
End Sub
You are copying a complete row with code like:
Sub dural()
Sheets("Sheet1").Rows(11).Copy Sheets("Sheet2").Rows(17)
End Sub
To copy only part of the row, use something like:
Sub dural2()
Set r1 = Intersect(Sheets("Sheet1").Rows(11), Sheets("Sheet1").Columns("A:N"))
Set r2 = Intersect(Sheets("Sheet2").Rows(13), Sheets("Sheet2").Columns("A:N"))
r1.Copy r2
End Sub
To answer your specific question, this code will only copy columns A:n of the specified row to the AMI Fallout worksheet.
Sheets("AMI").Cells(Cell.Row, 1).Resize(1, 14).Copy Sheets("AMI Fallout").Cells(iMatches + 1, 1)
I'm concerned about how you are determining a positive criteria for the row transfer. It looks like you are trying to Split a 0 on a comma (which doesn't exist) then loop through a single value array and check for partial matches on a 0. The partial matches produced by InStr are the most disconcerting.
Use something like this
Sheet1.Rows(cell.row) = sheet2.Rows(Cell.row).Value