Return Column Header of Colored Cells - vba

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

Related

comparing two cells in certain pattern VBA

I'm trying to compare two excel's cells in certain pattern using VBA. The table is separate by empty rows. And the patter is:
I'm looking at column A. If cell A1 is empty I'm moving to next one. If cell A2 is not empty then I'm compering $A2$ to B2, B3, B4, .. etc until I hit the empty cell. If so, then it moves to the next one (not empty), i.e. $A6$ and I'm continue to compering to B6, B7, ...
For defining the scope (range) of the loop I have the following:
LastRow1 = This.Sheets("List1").Range("A1048576").End(xlUp).Row
Which loop will fit this kind of pattern?
Many thanks in advance.
Correct me if I misunderstood you:
You want to loop through each line in column A till the last row.
Every time you have a value in column A, you want to compare this with the data in column B.
Maybe something like this:
LastRow1 = Range("A" & Rows.Count).End(xlUp).Row 'Determining the last row in column A
LastRow2 = Range("B" & Rows.Count).End(xlUp).Row 'Determining the last row in column B
For i = 2 to LastRow1 'Looping through every row
If Cells(i, "A") <> "" Then
For j = i to LastRow2 'looping through each row in column B from the same line as i in column A at that moment, column A6 f.e. will never compare with a value in B2:B5 for example, but only B6 till lastrow in column B
If Cells(i, "A") = Cells(i, "B") Then
<<do something if the value is found>>
End If
Next j
End If
Next i

How to get VLOOKUP to select down to the lowest row in VBA?

Looking to automate the insertion of a VLOOKUP formula in a cell.
When recording the macro I instruct it to populate the columns below with the same formula. Works great, however, there is an issue when the table that the VLOOKUP searches through changes (more or less rows).
As it's recorded, the VLOOKUP drops down to the final row in the table (273). However, I want to set it up so that it will go down to the very last row. Meaning that I can run the script on tables of varying numbers of rows.
Selected columns will remain the same.
Range("AJ2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-20], Previous!R2C2:R273C22,17,FALSE)"
try this:
With Worksheets("Previous")
Range("AJ2").FormulaR1C1 = _
"=VLOOKUP(RC[-20], Previous!R2C2:R" & .Cells(.Rows.Count, 2).End(xlUp).Row & "C22,17,FALSE)"
End With
where:
Range("AJ2")
will implicitly reference the ActiveSheet
.Cells(.Rows.Count, 2).End(xlUp).Row
will reference "Previous" worksheet, being inside a With Worksheets("Previous")- End With block
#nbayly said it, plenty of posts on this. Infact i have provided an answer to this before here:
How to Replace RC Formula Value with Variable
below is slightly modified for a dynamic range, which is what i believe you are looking for
For j = n To 10 Step -1
If Cells(j, 1).Value = "" Then
Cells(j, 1).Formula = "=VLookup(RC20,Previous!R2C2:R273C22,17,FALSE)"
End If
Next j
remember to define j as long and n=sheets("sheetname)".cells(rows.count,1).end(xlup).row
replace 10 in j = n to 10 with the starting row number

VBA Look for Duplicate, then assesses another cells value

I initially asked a question below.
Basically I want VBA to look at Column L:L. If the cell=program, and the cell below does not equal lathe I want the row above to be deleted. If the cell doesn't equal program continue looking until the end of the data.
Realized I needed to look at the data different, as I was losing rows that I needed to stay.
New logic, which I think will still use some of the old program, but
it needed to be sorted using another column. I need the VBA to look at
column E:E. If the cell in the row below is a duplicate of the cell
above, then look at column L in that row to see if the cell says
Program. If so the cell below should be Lathe. If not lathe delete the
Program Row, If it is Lathe leave both rows. If the Cells in Column E
are not duplicates, continue looking. EX. If E5=E6, If not continue
looking. If yes Look at L5 to see if it say Program. If so look at L6
for Lathe. If not delete ROW5.
This I what I received that answered teh first question which I think will still get used
Dim rngCheck as Range
Dim rngCell as Range
Set rngCheck = Range("L1", "L" & Rows.Count - 1)
For each rngCell in rngCheck
If rngCell.value = "Program" And rngCell.offset(1,0).value <> "lathe" then
rngCell.offset(-1,0).EntireRow.Delete
End if
Next rngCell
This should do it
For i = ThisWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row to 2 step -1
' that row do you mean the duplicate or the original (I am using original)
If ThisWorksheet.Cells(i, 5) = ThisWorksheet.Cells(i-1, 5) and _
ThisWorksheet.Cells(i-1, 12) = "Program" and ThisWorksheet.Cells(i, 12) <> "Lathe"
ThisWorksheet.Rows(i-1).EntireRow.Delete
End If
Next i
When deleting it is best to iterate from last to first. If prevent you from skipping rows.
Sub RemoveRows()
Dim x As Long
With Worksheets("Sheet1")
For x = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(x, "E").Value = .Cells(x - 1, "E").Value And Cells(x - 1, "L").Value = "Program" Then
.Rows(x).Delete
End If
Next
End With
End Sub

Macro to Skip Blank Lines

I understand that this is a question that has been asked before in a multitude of forms, but every time I try to use the solution to answer my problem, it's not working and I can't figure out how to adjust to make it work for me.
I have a sheet that, with formulas, pulls all of the data from a daily-updated spreadsheet based on NBA games; in other words, who they're playing, what their opponent's rank is, etc... This creates a large spreadsheet with a line for each player with the aforementioned data next to players who are active tonight.
If a player isn't active, his line is blank.
I want to set up a way to automatically parse a new sheet with just the list of active players, skipping the inactive players. I understand that I need to create a looped macro that will go through each cell and copy that cell value if it <>"", but I can't seem to get it to work.
I was able to answer this myself, sorry I wasn't able to post this sooner. I had the macro check for an empty cell in Column P, if there wasn't one, I had it copy that row to a sheet specified by that player's position.
Sub ActivePlayers()
Dim i As Long
Sheets("AllPlayers").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For i = 3 To FinalRow
' Decide if to copy based on column P and which sheet to copy to based on Column B
ThisValue = Cells(i, 16).Value
Position = Cells(i, 2).Value
If ThisValue <> "" Then
Cells(i, 1).Resize(1, 33).Copy
Sheets(Position).Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("AllPlayers").Select
End If
Next i
End Sub

Loop through columns and copy and paste cells A to B

I am working on a simple code but i have not able to crack it. i want the macro to run and pick up a value (2), and copy and paste the cells A to C , into sheet 2. The code below does copy the Cells A-B and pastes. I failing on the loop . I want it to loop from 1st row to last row. please.
Sub Tier_2()
With Sheets("Sheet1")
.Range(.Cells(1, 1), .Cells(3, 3)).Copy Sheets("Sheet2").Cells(1, 1)
End With
End Sub
This isn't for your specific situation, but the concept is what you are looking for. You should be able to do some research with what I'm showing you and figure it out.
lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 'gets last row of Source sheet
For x = 1 to lastRow
Sheets("Sheet2").Cells(x, 1) = Sheets("Sheet1").Cells(x, 1) 'copy data from Sheet1 to Sheet2 row x
Next x 'loop and add one to x
You can use variables for either the row or column numbers in either the source or target sheets. You can insert another loop inside the first one. I'm not sure of what you are looking for, but your question didn't seem to have a loop in it at all.
If that doesn't get you going in the right direction try "Do While Loop" in a search.
EDIT: Updated the formula to better reflect idea.