Macro to Skip Blank Lines - vba

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

Related

Return Column Header of Colored Cells

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

How do I automate copying data from one worksheet in Excel and append it to an existing table in another worksheet?

I have two sheets of data. The first sheet is imported data that will show total users to my site from the day before. The second sheet is a table with all historical data from those daily reports. I'd like to automate a way to copy the data from my first sheet (that data will always be in the same cell) to a new row at the bottom of my existing table. Here's what I have:
Sub Insert_New_Rows()
Dim Lr As Integer
Lr = Range("AF" & Rows.Count).End(xlUp).Row
Rows(Lr + 1).Insert Shift:=xlDown
Cells(Lr + 1, "AF") = Cells(Lr, "AF") + 1
Sheets("Day Before").Range("$A$12:$B$12").Copy
Sheets("Historical").Cells(Lr + 1, "AF").Paste
Application.CutCopyMode = False
End Sub
In this, you'll see that my table is in columns AF and AG. When I run this macro, it only adds a row, it does not copy and paste the information.
I am not really sure where your table starts on the sheet "Day Before". So, I am assuming that it starts in row 1. Based on this assumption here is a little revision to your code:
Option Explicit
Sub Insert_New_Rows()
Dim lngNextEmptyRow As Long
Dim lngLastImportRow As Long
Dim shtYstrdy As Worksheet
Set shtYstrdy = ThisWorkbook.Worksheets("Day Before")
With ThisWorkbook.Worksheets("Historical")
lngNextEmptyRow = .Cells(.Rows.Count, "AF").End(xlUp).Row + 1
.Rows(lngNextEmptyRow).Insert Shift:=xlDown
.Cells(lngNextEmptyRow, "AF").Value2 = _
.Cells(lngNextEmptyRow - 1, "AF").Value2 + 1
lngLastImportRow = shtYstrdy.Cells(shtYstrdy.Rows.Count, "A").End(xlUp).Row
shtYstrdy.Range("A1:B" & lngLastImportRow).Copy _
Destination:=.Cells(lngNextEmptyRow, "AF")
End With
End Sub
Changes:
Explicit coding as suggested by #findwindow stating the workbook and the sheet before each Range, Cells, reference.
Copy and paste in one line of code (before three lines of code).
Using lngNextEmptyRow instead of LastRow so be can skip all these +1.
Determine the size (last row) of the table on the sheet "Day Before", so we know how much we need to copy over.
I hope this is the answer you've been looking for. Let me know if I misunderstood something or if anything requires more explanations.
There is no need to Active or Select Ranges. It is best to work with the Ranges directly. Rarely should you use ActiveCell, ActiveWorkSheet, or Selection.
This is how Copy and Paste work
Here is the shorthand for Copy and Paste
Range(SourceRange).Copy Range(DestinationRange)
Know that this will work for you:
Sheets("Day Before").Range("$A$12:$B$12").Copy Sheets("Historical").Cells(Rows.Count, "AF").End(xlUp).Offset(1)

3D SumIf using List to loop all sheets final fix needed

I have the following to make a list of all the sheet names in the sheet summary in cell AI1, it then deletes the top 3, selects from AI4 to the bottom and names the range "Invoices"
I am trying to use this to do a sumif Formula over all the sheets. It works pasting it into a cell manually
but when in VBA,from '"&Invoices&"'!$A$2006:$A$3005"),$A3,INDIRECT("'"&Invoices&"'!B$2006:B$3005")))"
Onwards it is reading it as a comment (in green)
For i = 1 To Sheets.Count
Sheets("Summary").Range("AI1")(i, 1).Value = Sheets(i).Name
Next i
Sheets("Summary").Select
Sheets("Summary").Range("AI1:AI3").Clear
Sheets("Summary").Activate
Sheets("summary").Range(ActiveSheet.Range("AI4"),
ActiveSheet.Range("AI4").End(xlDown)).Select
Selection.Name = "Invoices"
Sheets("summary").Range("B3").Formula = "=SUMPRODUCT(SUMIF(INDIRECT("'"&Invoices&"'!$A$2006:$A$3005"),$A3,INDIRECT("'"&Invoices&"'!B$2006:B$3005")))"
To expand on my comment:
VBA thinks that " is the end of the string, so if you want it to actually be treated as a character you need to escape it as "".
Your code should be:
Sheets("summary").Range("B3").Formula = "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Invoices&""'!$A$2006:$A$3005""),$A3,INDIRECT(""'""&Invoices&""'!B$2006:B$3005"")))"
The easy way to check this when there are lots of characters is to write it in the immediate window. I put
? "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Invoices&""'!$A$2006:$A$3005""),$A3,INDIRECT(""'""&Invoices&""'!B$2006:B$3005"")))"
to confirm it.
Thanks,
so for anyone else who needs this, this is how it was done in full
*****'list all the sheet names in cell AI1 of the sheet summary*****
For i = 1 To Sheets.Count
Sheets("Summary").Range("AI1")(i, 1).Value = Sheets(i).Name
Next i
***'clear the first 3 entries in AI as i didnt need the first three sheet names***
Sheets("Summary").Select
Sheets("Summary").Range("AI1:AI3").Clear
***'select the first sheet name, which is in AI4 as we cleard the first 3 to the last used cell, e.g Ctrl.Shift.down***
Sheets("Summary").Activate
Sheets("summary").Range(ActiveSheet.Range("AI4"), ActiveSheet.Range("AI4").End(xlDown)).Select
***' Name the range invoices***
Selection.Name = "Invoices"
' ***Formula to do a sumIf looping all the shets in the named range Invoices***
Sheets("summary").Range("B3").Formula = "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Invoices&""'!$A$2006:$A$3005""),$A3,INDIRECT(""'""&Invoices&""'!B$2006:B$3005"")))"

Sort excel list by value

I am working with a file that has 10 columns with varied data in each one. There is only one column that has (fairly) consistent data. I will attach the file so that hopefully it will help with what I am trying to do.
I want to have the unique values copy over to another worksheet. There are multiple ACD options, but I only want ACD to be copied IF the cell above it contains the value RING. Additionally, I would like to copy over the first TIME column, if possible the second. If necessary I will have a macro change the names to the second column to length.
Data File
I know that advanced filters can be utilized but I have not yet been able to figure out how to properly set it up.
Any tips would be greatly appreciated!
Is this what you needed? I'm pretty new to VBA though but it works.
Sub CopyData()
Dim lastrow As Long, LocY As Long, lastcopy As Long
Dim source As Worksheet, dest As Worksheet
Set source = Worksheets("Sheet1")
Set dest = Worksheets("Sheet2")
lastrow = source.Cells(Rows.Count, 1).End(xlUp).Row 'Checks for the last row that contains data in the source
lastcopy = dest.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Checks for the last row with data in the destination and move down by one to prime for data entry
For LocY = 2 To lastrow 'LocY referring to current location
If source.Cells(LocY, 7).Value = "RING" Then 'Check if current locations at column 7 in source sheet contains the value RING
source.Cells(LocY, 2).Copy
dest.Cells(lastcopy, 1).PasteSpecial xlPasteValues 'pastes the value into the last row of destination sheet.
source.Cells(LocY, 7).Copy
dest.Cells(lastcopy, 2).PasteSpecial xlPasteValues
source.Cells(LocY, 10).Copy
dest.Cells(lastcopy, 3).PasteSpecial xlPasteValues
lastcopy = lastcopy + 1 'moves the target row in the destination down by one to prime for data entry.
End If
Next
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.