Selecting all data from a default table size VBA Excel - vba

I have a spread sheet with a default table size and layout that is populated by information from another spread sheet. This table will always have the same number of columns, but the number of entries in the rows can vary. I want to select all the data from the table, and paste it into another sheet, without copying any empty rows.
My initial attempt involved the following code:
Set rightcell = Range("B9").End(x1Right)
Set bottomcell = Range(rightcell).End(x1Down)
To define what the bottom right corner should be, so I can reference the entire table like so:
Range("B9", bottomcell).Select
Or copy or whatever. When I run this, it gives me a "user-defined or object-defined error" and I don't know why. I have the code entered as part of a larger sub, and I have defined my variables as both ranges and variants to try and get this to work. I have spent quite a bit of time scouring the internet for a solution, but so far the information I've found has not explicitly related to my problem, and none of the similar solutions work.
Does anyone know what the appropriate coding for this is, or if I am making some minor error that is throwing everything else off? I remember encountering the same issue during a project in college, but for the life of me, I can't recall the solution. It's quite frustrating.
Also, if I am too vague or you need more clarification on the task, don't hesitate to ask. Thanks in advance for the help!
EDIT: An important note that I left out is that the the table I want to extract data from is in the middle of a page with multiple other tables that I am not trying to interact with.

If the table will always be in the same location on the sheet, you can do something like this to copy the entire table:
'Modify this to any cell in your table (like the top left hand cell):
Range("B9").CurrentRegion.Copy Sheets("TheSheetYouWantToPasteTo").Range("A1")
Even if the table's location on the sheet changes, you can still use the above code to copy the table as long as you know one of the cells in the table.
If you want to keep the same method as you're trying, try this instead:
Dim rightcell As Long
Dim bottomcell As Long
'Finds the furthest column to the right:
rightcell = Cells(5, Columns.Count).End(xlToLeft).Column
'Finds the bottom most row in the table (will stop at the first non-blank cell it finds.)
bottomcell = Range("B:B").Find("*", Range("B9"), searchdirection:=xlPrevious).Row
'Reference the variables like this:
Range(Cells(9, 2), Cells(bottomcell, rightcell)).copy _
Sheets("TheSheetYouWantToPasteTo").Range("A1")

this is what I use
Public Function last_row() As Long
Dim i As Integer
Dim l_row As Long
'my sheet has 35 columns change this number to fit your
For i = 1 To 35
If Sheet1.Cells(Rows.Count, i).End(xlUp).Row > l_row Then
l_row = Sheet1.Cells(Rows.Count, i).End(xlUp).Row
End If
Next i
last_row = l_row
End Function
Then Use
Dim l_row As Long
l_row = last_row
'Again since you know the last column change 35 here to your value
'or use the String i.e. "AI"
Range("B9", Cells(l_row,35)).Select
This will look at every column to determine the the last row that contains data

Related

Copy Range Excluding Blank Cells - Paste to Another Sheet

Ok, back again!
I have tried to search throught this and other forums to find a similar solution, but everything Ive found is either just different enough that I cant figure out the application to my problem, or super complex, and I cant translate it! So Im hoping someone can help me here. Thanks in advance!!
Here is the scenario. I have a database that Im needing to add data to. Quote Number, PO Number,SubSystem Part Name, Vendor, Material, Price, Qty. Etc.
Long story short, and without getting into the context of why I did it this way (mostly because I think I would botch the explaination and be more confusing than helpful!) ... I have essentially 3 tables right next to each other.
Table 1 is columns H and I. These all have a formula similar to =if(isblank(J4),"",$I$1) Where I1 is the PO Number (which will remain the same for this set of entries.)
Table 2 is a pivot table in columns J through M. Using a slicer the user can select what sub systems they need for this PO. The pivot table will repopulate with the appropriate part numbers and unique information contained in another table.
Table 3 is a regular table in columns N through R. These columns have some formulas like above that pull from a single cell (for entering the date), some pull information from another table based on information in column J via a VLOOKUP, and some information is entered manually.
That might be too much information, but better to have it and not need it eh?
So heres the goal. With a VBA macro, I want to copy the data and paste it onto another sheet, at the bottom of a database. The trick is, because that whole setup above runs based on information coming from a pivot table, the list changes length constantly. It will never be longer than a certain length (still TBD) but will almost always be shorter. I can copy the whole thing, and have it paste to another sheet below the last entry... but it pastes below the last empty cell in the database sheet. What I mean is this:
The longest the table could be would be range H4:R38 for example. So I copy that, paste it to Sheet2 starting at cell A2. Upon further inspection, we see that there is only actual data in the range H4:R11. However, when we pasted it to Sheet2 it pasted the whole range H4:R38. When I run the macro again, instead of the new data set being pasted to row A10 (the row after where the data should have ended), it pastes to something like row 36... because its pasting below all the blank cells.
I have no idea what to do or where to start. Any help would be greatly appreciated! Thanks so much!
Code I've Tried:
Dim fabricationrange As Range
Dim destination As Range
Dim LastBBUFabDatabaseRow As Long
Worksheets("Sub Systems").Range("h4:r38").Copy
With ThisWorkbook.Sheets("BBU Fab. Database")
Worksheets("bbu fab. database").Range("z" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
lastbbufabdatabserow = .Cells(.Rows.Count, 2).End(xlUp).Row = 1
Set destination = .Cells(LastBBUFabDatabaseRow, 2)
destination.Value = PasteSpecial.Values
End With
Untested but here's a brute-force approach to locating the first empty row:
set rngDest = ThisWorkbook.Sheets("BBU Fab. Database").rows(2) '<< start here
do while application.counta(rngDest) > 0
set rngDest = rngDest.offset(1, 0) 'next row
loop
Worksheets("Sub Systems").Range("H4:R38").Copy
rngDest.cells(1).PasteSpecial xlPasteValuesAndNumberFormats '<< paste to col A

Excel VBA Get Count of Non-Empty Rows in Range

I know this has been asked at least a dozen times, but of all those questions the solutions seemed to be tailored or simply created an error in my code. For some reason I get an error when I try and reference a range from a different worksheet. Below is my code. I have two worksheets (tabs). One has a button to launch my code MENU, the other is the data I am trying to read and write to RAW. All I am trying to do is find out how many rows of data the sheet has so I can loop through the rows and make changes. For some reason I can't wrap my head around it or something.
Private Sub CommandButton21_Click()
Dim wbCurrent As Workbook
Dim wsCurrent As Worksheet
Set wbCurrent = ThisWorkbook
Set wsCurrent = wbCurrent.Worksheets("RAW")
Dim i As Long
Dim siteCol As Long
siteCol = Range("I" & Rows.Count).End(xlUp).Row
For i = 1 To siteCol
wsCurrent.Range("I" & i) = "MARKED"
Next i
Range("I1") = siteCol
End Sub
1- Always use Long for your variables, not Integer unless you have a specific reason. The maximum value of an Integer is 32767, which might be not enough to hold your count of rows.
2- Dont get the number of rows with COUNTA, this has many drawbacks. use this instead:
siteCol = wsCurrent.Range("I" & wsCurrent.Rows.count).End(xlUp).Row
This finds the Row number of the last occupied cell in wsCurrent, assuming that wsCurrent is at the top of the document (it starts on Row 1). Please note that if wsCurrent is completely empty, this will find the row number of the first occupied cell above wsCurrent, or the first row of the document.
3- When you want to assign a whole range to the same value, you can do it at once, which is much faster and simpler, like this (no loop needed):
wsCurrent.Range("I1:I" & siteCol) = "MARKED"
4- No need to Activate a worksheet to work with it. Drop the statement wsCurrent.Activate and try to always work with qualified ranges.

Find specific cells, change value of adjacent cell, value depends on location (Excel for Mac, 15.6)

this is my first post here, I know I'm articulating this poorly.
I'm trying to find cells containing a specific phrase in a column of dates. This phrase marks the beginning of a section. I then want to state the number of days elapsed from the first date in each section to other dates in the section. The values returned should show up in the adjacent column. Below is an example of the columns.
Dates and Elapsed number of days in adjacent column
I use this formula in the 2nd column:
=A15-$A$15
And then drag this down to cells in the relevant section. I'm trying to automate this process.
I found this code on this site and changed it a little bit to get this:
For Each cCell In Range("A1,A900")
cCell.Select
If ActiveCell.Value = "Phrase" Then
ActiveCell.Offset(1, 1).Value = "-"
End If
Next cCell
So my struggle is what to say in the 2nd Value field. I somehow need to get each section to subtract the first date of each section (the date right under "Phrase").
Another challenge is to copy that first adjacent cell that was changed, and then paste special into the cells below, but stopping once the next "Phrase" appears.
I'll elaborate any way I can. Thanks.
I think it's fair to say your question doesn't show much effort at solving this problem and the code snippet simply places a dash next to a "Phrase" cell. However, for a wider audience the question is interesting because it highlights the difference between automating an Excel keystroke task and writing code to process data which is then written in an Excel worksheet. Both use VBA but the former is simply a programmatic record of keystrokes and the latter is an algorithmic solution.
The telling phrase in your question is: I use this formula in the 2nd column ... and then drag this down to cells in the relevant section. I'm trying to automate this process. It would be possible to do this by using VBA to reproduce a bunch of worksheet functions but it's fiddly and could become complicated. I'll leave someone else to answer that as they'd need to spend more time on the answer than you have on the question (one of my don't do rules!).
If, on the other hand, you step away from trying to automate keystrokes and towards VBA for data processing, the problem becomes very trivial. It's a really good example of how VBA, in just a few lines, can solve problems that Excel functions might take pages to do, and probably not reliably.
So here's the code as a VBA solution. It'll need some data checking lines added to deal with blank cells, non-dates, etc. but I'll hand that task back to you:
Dim ws As Worksheet
Dim firstCell As Range
Dim lastCell As Range
Dim dataCells As Range
Dim v As Variant
Dim output() As Variant
Dim r As Long
Dim refDate As Long
'Define the range to be worked
Set ws = ThisWorkbook.Worksheets("Sheet1") 'amend as required
Set firstCell = ws.Range("A1") 'amend as required
Set lastCell = ws.Cells(ws.Rows.Count, "A").End(xlUp) 'amend as required
Set dataCells = ws.Range(firstCell, lastCell)
'Read the values and size the output array
v = dataCells.Value2 'use Value2 to avoid date format issues
ReDim output(1 To UBound(v, 1), 1 To 1)
'Loop through the values, resetting the reference date on each "Phrase"
For r = 1 To UBound(v, 1)
If v(r, 1) = "Phrase" Then
output(r, 1) = "-"
refDate = v(r + 1, 1)
Else
output(r, 1) = v(r, 1) - refDate
End If
Next
'Write output into next column
dataCells.Offset(, 1).Value = output

Condense largely(Unpractical) loop based VBA code; nested For...Next loops

Hello everyone alright let start by giving some brief background on my project then I will follow up with my specific issue and code.
Currently I am building a program to automate the process of filling a template. This template exceeds 60,000 rows of data quite often and I've built the large majority of it to work month to month by plugging in new data sheets and running it. Currently all of the work is based off of one data sheet which I import into excel manually. This data sheet does not contain all the data I need to populate the template so now I am beginning to bring in additional data to supplement this. The problem herein lies with data association. When I was originally pulling from one data sheet I didn't have to worry if the data I pulled for each row coincided with the other rows because it all came from the same sheet. Now I have to cross check data across two sheets to confirm it is pulling the correct information.
Now for what you need to know. I am trying to fill a column that will be referred to as Haircut, but before I do that I need to confirm that I am pulling the correct haircut number in correlation to a Trade ID which was already populated into the template in a previous line of code.
Using similar logic that I have been using throughout my entire project this is a snippet of code I have to perform this task.
Dim anvil as Worksheet
Dim ALLCs as worksheet
Dim DS as worksheet
'''''''''''''''''''''''''''''code above this line is irrelevant to answer this question
ElseIf InStr(1, DS.Cells(x, 2), "Haircut") Then
Anvil.Select
For y = 1 To 80
If Anvil.Cells(1, y) = "Haircut" Then
For Z = 1 To 80
If Anvil.Cells(1, Z) = "Trade ID" Then
For t = 2 To 70000
For u = 16 To 70000
If Anvil.Cells(t, Z) = ALLCs.Cells(u, 34) Then
ALLCs.Cells(u, 27) = Anvil.Cells(t, y)
End If
Next
Next
End If
Next
End If
Next
This code coupled with my other code I assume will in theory work, but I can only imagine that it will take an unbelievable amount of time(this program already takes 7 and a half minutes to run). Any suggestions on how to rewrite this code with better functionality, following this general logic?
Any help is appreciated, whether you completely revamp the code, or if you offer suggestions on how to cut down loops. I am also looking for suggestions to speed up the code in general aside from screen updating and calculation suggestions.
If I understand the logic correctly then you can replace all but one of the loops with a .Find() method like so:
'// Dimension range objects for use
Dim hdHaricut As Excel.Range
Dim hdTradeID As Excel.Range
Dim foundRng As Excel.Range
With Anvil
With .Range("A1:A80") '// Range containing headers
'// Find the cell within the above range that contains a certain string, if it exists set the Range variable to be that cell.
Set hdHaircut = .Find(What:="Haircut", LookAt:=xlWhole)
Set hdTradeID = .Find(What:="Trade ID", LookAt:=xlWhole)
End With
'// Only if BOTH of the above range objects were found, will the following block be executed.
If Not hdHaricut Is Nothing And Not hdTradeID Is Nothing Then
For t = 2 To 70000
'// Using the .Column property of the hdTradeID range, we can see if the value of Cells(t, hdTradeColumn) exists
'// in the other sheet by using another .Find() method.
Set foundRng = ALLCs.Range(ALLCs.Cells(16, 34), ALLCs.Cells(70000, 34)).Find(What:=.Cells(t, hdTradeID.Column).Value, LookAt:=xlWhole)
'// If it exists, then pass that value to another cell on the same row
If Not foundRng Is Nothing Then ALLCs.Cells(foundRng.Row, 27).Value = .Cells(t, hdHaircut.Column).Value
'// Clear the foundRng variable from memory to ensure it isn't mistaken for a match in the next iteration.
Set foundRng = Nothing
Next
End If
End With

Take results from one sheet and move them into many other sheets

I have looked at similar answers to this question, but whatever I do I cannot get them to do what I need.
I have a daily email which has a CSV file giving call stats for our Sales team for the previous day. What I need is to put them into Excel to give trending and historical call activity for the year. Without VBA or Macros this is a very time consuming process.
The stats it gives are number of calls, and average call length (that are of any importance) I have already got VBA to calculate the total outgoing with this:
Dim Call_Number As Integer
Dim Call_Time As Date
Dim Call_Total As Date
Call_Number = .Cells(2, 6).Value
Call_Time = .Cells(2, 7).Value
Call_Total = Call_Number * Call_Time
.Cells(12, 7).Value = Call_Total
So what I need is to take the 3 cells for each sales member, and move them into the right place in their relative sheets, which are separated by name. I also need it to move into the next cell to the right if the destination cell is full, so I'm thinking I need to start the pasting process as Jan 1st and keep moving to the right until it finds blank cells. Is there a way this can be done either in a button or automatically?
I have the first sheet used as the data import sheet, where we just import the data into csv, and because its standard formatting, every day it will give it all in the right formatting.
Code I have so far. It doesn't error, but doesn't do anything:
Sub Move_Data()
Dim Dean As Worksheet
Dim Chris As Worksheet
Dim Paul As Worksheet
Dim Nigel As Worksheet
Dim Calc As Worksheet
Dim Lastrow As Long
Dim J As Long
Dim i As Long
Set Dean = ThisWorkbook.Worksheets("DEAN 822")
Set Chris = ThisWorkbook.Worksheets("CHRIS 829")
Set Paul = ThisWorkbook.Worksheets("PAULP 830")
Set Nigel = ThisWorkbook.Worksheets("NIGEL 833")
Set RUSSELL = ThisWorkbook.Worksheets("RUSSELL 835")
Set Calc = ThisWorkbook.Worksheets("Calculation Sheet")
Lastrow = Range("C" & Dean.Columns.Count).End(xlToRight).Column
J = 2
For i = 0 To Lastrow
Set Rng = Dean.Range("C5").Offset(i, 0)
If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
Calc.Cells(2, 4).Copy
Dean.Range("c" & J).PasteSpecial xlPasteValues
J = J + 1
End If
Next i
Application.CutCopyMode = False
End Sub
Instead of
Lastrow = Range("C" & Dean.Columns.Count).End(xlToRight).Column
I think you want
Lastrow = Range("C" & Dean.Columns.Count).End(xlUp).Row
"I also need ... in a button or automatically?"
LastCol = WshtName.Cells(CrntRow, Columns.Count).End(xlToLeft).Column
will set LastCol to the last used column in row CrntRow.
J = 2
For i = 0 To Lastrow
Set Rng = Dean.Range("C5").Offset(i, 0)
If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
Calc.Cells(2, 4).Copy
Dean.Range("c" & J).PasteSpecial xlPasteValues
J = J + 1
End If
Next i
Application.CutCopyMode = False
I am not sure what this code is attempting.
It sets Rng to C5, C6, C7, C8, ... to Cn where n is Lastrow+5. If C5, for example, if empty it copies C2 to `Calc.Cells(2, 4).
Did you mean to copy column C from worksheet Dean to column B of worksheet Calc?
If the removal of empty cells is not important then this will be faster and clearer:
Set Rng = Dean.Range(.Cells(5 ,"C"), .Cells(Lastrow ,"C"))
Rng.Copy Destination:=Calc.Cells(2, 4)
New information in response to comment
I cannot visualise either your source data or your destination data from your description so cannot give any specific advice.
Welcome to Stack Overflow. I believe this is a good place to find previously posted information and a good place to post new questions but you must follow the site rules.
Right of centre in the top bar is the Help button. Click this and read how to use this site. Learn how to post a question that will be classified as a good question and will be answered quickly and helpfully.
I believe the biggest three problems with your question are:
You ask too much. You can ask as many good questions as you wish but there should only be one issue per question.
You ask for information that is already available.
You are too vague about your requirement to permit anyone to help. You say you want to move three values per staff member. But you do not show how either the worksheet “Calculation Sheet” or the staff member worksheets are arranged. You cannot post images until you have a higher reputation but you can use the code facility to create “drawings” of the worksheets.
To avoid asking too much, you must break your requirement into small steps. The following is my attempt to identify the necessary small steps based on my guess of what you seek.
The CSV files containing staff detail arrive as attachments to a daily email. Are you manually saving those attachment? An Outlook VBA macro to save an attachment would not be difficult to write. I suggest you leave this for later but if you search Stack Overflow for “[outlook-vba] Save attachment” you will find relevant code.
The above shows how I search Stack Overflow. I start with the tag for the language and follow it with some key words or a key phrase. Sometimes it takes me a few goes to get the right search term but I rarely fail to find something interesting
How are you importing the CSV to Excel? Are you doing this manually? There are many possible VBA approaches. Try searching for “[excel-vba] xxxx” where xxxx describes your preferred approach.
I assume the structure of the CSV file is pretty simple and there is no difficulty in find information in the individual rows. You appear to know the easiest technique for finding the last row so you should have no difficulty in creating a loop that works down the rows.
How do you relate the staff member’s name in the CSV file with the name of their worksheet? In your question you have worksheet names such as "DEAN 822", "CHRIS 829" and "PAULP 830". Are these the names used in the CSV file? What happens when a new staff member joins? I doubt this happens very often but you do not want to be amending your macro when it does happen.
I do not understand your requirement for the new data to be added to the right of any existing data. There will be three values per day so with around 200 working days per year that gives 600 columns. To me that sees an awkward arrangement. I would have thought one row per day would have been more convenient.
How will you run the macro? You mention a button or automatically. I do not like buttons since I find the tool bars cluttered enough already. I prefer to use shortcut keys such as Ctrl+q. I rarely have more than one macro per workbook of this type so that works well for me. By automatically, I assume you mean the macro will run automatically when the workbook is open. I would start with the shortcut key but when you are ready look up “Events” and “Event routines”. You will find an explanation of how you can have a macro start automatically when the workbook opens.
I hope the above is of some help.