Find Worksheet Name and Row Number for an Excel Workbook - vba

I am working with a workbook that contains three worksheets of data. Each worksheet has a Contract Number column. Certain contracts must be excluded and noted in a separate worksheet.
I would like to create Excel VBA macro that:
Prompts the user to enter specific contract numbers to be excluded
Stores contract numbers
Searches all three worksheets' contract column for the contract numbers
Notes the unwanted contract details in a "summary" worksheet, which has already been created
Deletes the unwanted contract row entirely
The macro should loop through this process below for 'n' number of contracts entered by the user.
Public contString As String
Public x As Variant
Public xCount As Variant
Sub find()
contString = InputBox(Prompt:="Enter contract numbers to exclude(Comma Delimited). Cancel to include all contracts.", _
Title:="Exclude Contracts", Default:="1715478")
x = Split(contString, ",")
xCount = UBound(x) 'Number of contracts entered by user
End Sub
Sub SearchWS1()
Sheets("WS1").Activate
Columns("I:I").Select 'Contract Number Column
Selection.find(What:=x(i), After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
BKWS = ActiveCell.Worksheet.Name
BKRow = ActiveCell.Row
If BKRow > 0 Then
Cname = Range("G" & BKRow)
Cnumber = Range("I" & BKRow)
Cvalue = Range("K" & BKRow)
'Summarize Excluded Contract Info on Summary WS
Range("Summary!B25").Value = "Exclusions:"
Range("Summary!B26").Value = Cnumber
Range("Summary!C26").Value = Cname
Range("Summary!D26").Value = Cvalue
'Select and Delete Contract
Rows(ActiveCell.Row).Select
Rows(BKRow).EntireRow.Delete
Else
Call SearchWS2 'SearchWS2 is essentially the same as SearchWS1 and Calls SearchWS3 if contract isn't found.
End If
End Sub
If the contract number doesn't exist in the first WS, I get an error like 'Object variable or With block not set'. Once I can fix this error, I will need to run this process through a loop for each contract number entered by the user. Any help with debugging the error or setting up a loop for this would be greatly appreciated.
Thanks!

Use the InputBox for inputting contract numbers (let's say, comma delimited). Split the result using Split function.
Store contract numbers on a separate worksheet that you hide (wks.visible=xlVeryHidden, where wks is a worksheet object).
Find values using a multidimensional array to store the values.
Print 2D array to found worksheet using rFound=saArray (where rFound is a range object and saArray is the 2D array.
Make heavy use of recording macros to learn syntax.
See this example on fast ways to retrieve and print to cells.
Update:
Sorry, this is pretty sloppy but I just threw it together and, obviously, it hasn't been tested. Hope this helps. Sorry, I also shouldn't be having you use advanced techniques like this, but it's hard for me to go back.
dim j as integer, k as integer, m as long, iContractColumn as integer
Dim x() as string, saResults() as string
dim vData as variant
dim wks(0 to 2) as worksheet
iContractColumn=????
set wks(0) = Worksheets("First")
set wks(1) = Worksheets("Second")
set wks(2) = Worksheets("Third")
redim saresults(1 to 100, 1 to 2)
m=0
'Loop thru worksheets
for j=0 to 2
'Get data from worksheet
vdata=wks(j).range(wks(j) _
.cells(1,iContractColumn),wks(j).cells(rows.count,iContractColumn).end(xlup))
'Loop through data
for k=1 to ubound(vdata)
'Loop through user criteria
For i = 0 To UBound(x)
'Compare user criteria to data
if x(i)=cstr(vdata(k,1)) then
'Capture the row and worksheet name
m=m+1
'If array is too small increase size
if m>ubound(saresults) then
redim preserve saresults(1 to ubound(saresults)*2, 1 to 2)
end if
'Get name and row.
saresults(m,1)=wks(j).name
saresults(m, 2)=k
exit for
end if
next i
next k
next j
'Resize array to correct size
redim preserve saresults(1 to m, 1 to 2)
'Print results to a result page (you could also create hyperlinks here
'that would make it so the person can click and go to the respective page.
'You would have to do a loop for each result on the range.
with worksheets("Result Page")
.range(.cells(1,1),.cells(m,2))=saresults
end with

I have little to add Jon49's answer which does seem to cover the basics. But I wish I had discovered Forms earlier in my VBA programming career. They can be a little confusing at first but, once mastered, they add enormously to the usability of a macro for very little effort.
Forms can be used to get values from the user (instead of InputBox) or can be used to give progress information to the user. I will only talk about the second usage. Your macro might take some time; has the user time to get a cup of coffee or will it finish in 5 seconds? I HATE programs that sit there saying "please wait - this may take from a few minutes to a few hours".
The following code loads a form into memory, shows it to the user and removes it from memory at the end. If you do not unload the form, it remains on the screen after the macro has ended which may be useful if you want to leave a message for the user. This form is show "modeless" which means the macro displays it and carries on. If shown "modal", the macro stops until the user has entered whatever information the form requires.
Load frmProgress
Progress.Show vbModeless
' Main code of macro
Unload frmProgress
There are no end to the web sites offering tutorials on Forms so I will mainly describe the what rather than how.
Within the VB Editor, Insert a UserForm. Drags the bottom and right edges if you want it bigger. Use the Properties Window to change the Name to frmProgress.
Drag four labels from the Tool Box and arrange them in a line. Set the caption of label 1 to "Worksheet " and the caption of label 3 to "of". Name label 2 "lblWSNumCrnt" and name label 4 "lblWSNumTotal".
Add the following around "for j = 0 to 2"
frmProgress.lblWSNumTotal.Caption = 3
for j = 0 to 2
frmProgress.lblWSNumCrnt.Caption = j + 1
DoEvents
This means the user will see the following with n stepping from 1 to 3 as the macro progesses:
Worksheet n of 3
Add another four labels for row number, and the following code around the k loop:
frmProgress.lblRowNumTotal.Caption = ubound(vdata, 1)
for k = 1 to ubound(vdata, 1)
frmProgress.lblRowNumCrnt.Caption = k
DoEvents
Now the user will see something like:
Worksheet 2 of 3
Row 1456 or 2450
The above technique is simple and does not involve any change to Jon49's code. The following technique, borrowed from Wrox's excellent Excel VBA Programmer's Reference, is a little more complicated but gives your macro a more professional appearance.
Create a label that runs across the entire form. Name it "lblToDo" and colour it white. Create another label of the same size over the top. Name it "lblDone" and colour it black.
Create a copy of the code to count the rows in each sheet at the top so you can calculate the total number of rows, "TotalRowsTotal", before you do anything else.
Create a new variable "TotalRowsCrnt", initialise it to zero and add one to it for every row in every worksheet.
Within the inner loop, add:
frmProgress.lblToDo.Width = _
frmProgress.lblDone.Width * TotalRowsCrnt / TotalRowsTotal
For Excel 2003, which all the organisations I work with still use, this gives a progress bar with the black Done label steadily covering the white ToDo label. Later version of Excel may offer a progress bar control as standard.
I hope this gives you some ideas for making your macros more attractive to your users.

Related

Find and placing elements in a long string/column of text

The following is the result of downloading information from an accounting system. Basically, I was tasked with sorting through expenses from this year from an online system; once the information was downloaded from the online system, it was not formatted as a spreadsheet (so I couldn't easily use a simple lookup). The information was downloaded as a spreadsheet, however it didn't contain check numbers or names; excel formatted those away for some reason. The only thing that was left is the long stringy document, where each item in the PDF downloaded (which contained check numbers and names) was placed in column 1 (see picture 1), whereas it should have been placed in something formatted like picture 2. Obviously though PDF's do not maintain formatting.
So baring some way that I can transfer the PDF to a workbook and run an analysis (IE through copy paste or save as) I needed to get information from this long stringy thing (it's at 9000 rows at the moment, added in an excerpt).
First, this code sets the worksheet pers as a worksheet, gets the length of data in pers (example in picture 2), and length of data in expensesheet (example in picture 1)
Then it scans pers for items (prior to writing this code items were added manually - such as in the case of picture 2, 'supply 1' and corresponding information that can help denote supply 1, ie invoice #, description, date cut, and so on).
For each of those items, it then scans the "expense sheet". It tries to match the invoice number (which is the closest thing to a unique ID in this case) to the value in cell i, 1; if it exists, it then scans 'upwards' until it finds a long enough string so that it can be the 5 unit string; the one that contains a date, a check number, an amount, and a name, as well as a batch number and a memo.
Once it finds that string, it then splits it into an array, and then seeks to place it in the corresponding cells to the right of that row in worksheet pers.
Issues:
1) I keep receiving an error 400. Normally when I receive an error VBA shows what line. What is this? How can I set up an error catching block so that the editor will provide me more details on the error (ie place it occurred, reason for occurrence, etc)
2) I'm assuming that the long row (in this case its 12th from the top) can only be identified through its length. Is there a better way to identify the long row? Perhaps if it contains multiple dashes?
3) Does anyone know of a way to easily transfer a PDF of an accounting printout so that it retains its formatting when saved or copied to a spreadsheet?
4) Is there a way that this spreadsheet could be easily formatted through excel so that it can more adequately fit into the proper mold (more like picture 2)?
Option Explicit
Sub findDetailMemo()
Dim pers As Worksheet
Set pers = ThisWorkbook.Sheets("PERS")
Dim persLength As Long
persLength = pers.Range("a1").End(xlDown).Row
Dim expenseLength As Long
expenseLength = Range("a1").End(xlDown).Row
Dim currentDetail() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempInt As Long
'first scan all of the items in the pers unit
For k = 2 To 10
'next scan all of the expenses
For i = 2 To expenseLength
'if the invoice # is found
If InStr(Cells(i, 1), pers.Range("a1").Offset(k, 3)) <> 0 Then
'scan upwards; make sure you don't scan beyond the range of the spreadsheet
For j = i To 1 Step -1
'if the scan upwards finds a string that is 80 characters or more
If Len(Cells(i - j, 1)) >= 80 Then
'split it at the -
currentDetail = Split(Cells(i - j, 1), "-", -1, vbTextCompare)
'add it to the pers sheet
pers.Range("a1").Offset(k, 11) = currentDetail(0)
pers.Range("a1").Offset(k, 12) = currentDetail(1)
pers.Range("a1").Offset(k, 13) = currentDetail(2)
pers.Range("a1").Offset(k, 14) = currentDetail(3)
Exit For
End If
Next j
Exit For
Else
End If
Next i
Next k
End Sub
EDIT: After a discussion through the chat lobby, bdpolinsky and I found what was throwing the original error 400 (which was actually error 1004).
The first issue we fixed was the InStr() and Split() functions were referencing Cell objects instead of the string within them. This was fixed by simply adding Cells().Text where strings were required.
On the line If Len(Cells(i - j, 1).Text) >= 80, we discovered that Cells() wasn't referencing the correct worksheet. The fix for this was to define Cells() as pers.Cells(), which is the worksheet the information was imported to. Happy to report that the problem bdpolinsky was having has been solved (as far as the errors go).
The following is from the original answer:
1) At the start of your code (first executable line) you can press F8 to step through the code 1 line at a time until the error is flagged.
You can also use error handlers to catch an error and have excel do something different than default. Error Handling
Sub SomeCode()
Dim i As Integer
On Error GoTo ErrHandler
i = 1/0
ErrHandler:
MsgBox "Error Description: " & Err.Description
End Sub
You can also click next to a line of code to add a Break. Breaks look like red circles, and color that line of code red. Your code will stop when it reaches this line.
2)If Len(cellThatYoureChecking) > 20 Then Code
Or
If InStr(cellThatYoureChecking, "symbolYouWantToFind") <> 0 Then Code
Or visit this post about defining how many times a character is in a string with a function. You could then make your If statement based on the number of times it occurs.
3) This part is poor form for StackOverflow, but what you're asking is a little involved so see if this tutorial is of use to you. Import table from PDF to Excel.
4) The short answer to this is yes. There are a lot of ways to reorganize data in Excel. This question is a little too broad though, and it'd be more efficient to get questions 1-3 answered first before getting too ahead of ourselves.

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

Searching a column and evaluating adjacent cell in excel

I'm trying to make a spreadsheet that can tell me when somebody is in doing two things at the same time. say column A contains names, column B has the sign in time, and C has Sign out time. I am trying to find a way to assess whether any other instances of the same name had overlap in the time in and time out. I considered Vlookup, but that only gets me to the first instance.
Essentially I'm looking for if(A from this row exists anywhere else in column A and the adjacent B cell >= this row's B cell and the adjacent C cell >= this row's C cell, then true, otherwise do something else)
I work in a machine shop, and it's very common for people to work two machines at the same time. I understand my example a moment ago was only one of several possible ways the times could overlap, but if I could get help getting that far I would be ecstatic. even pointing me in the broadest of directions like "not possible without learning to code" would be helpful.
My excel skills are limited essentially to what I can learn in the help file, and as of now I'm ok with ifs. Any help would be appreciated. Do I need to learn VBA for this?
I am not an Excel power user. I learnt VBA because of employers who provided me with Excel but would not allow me use of other programmable tools. I have never made serious use of the more advanced capabilities of Excel. There are a surprising number of questions that get the comment, "you could do this with a Pivot table" but never an explanation of how. To be fair questions about Pivot Table belong on the SuperUser site but I find it a really unhelpful comment.
I do not know and do not care if your requirement can be met with a Pivot Table. I wish to show how simple tasks can be solved with VBA even if they cannot be solved with advanced Excel functionality. The macro below did not take long to write and I believe it meets your requirement.
Yes you should learn VBA. It does not take long to learn the basics and it can be used to solve many simple problems. I cannot imagine not being able to create macros or programs to solve day-to-day problems.
Search the web for "Excel VBA tutorial". There are many to choose from. Try a few and complete one that matches your learning style. I prefer books to online tutorials. I visited a large library and checked out their Excel VBA Primers. I then bought the one that worked best for me.
I will admit there is a lot of practice behind the macro below but I believe the real skill is in breaking your requirement into steps that can be solved easily with Excel VBA.
I created a worksheet Log which I filled with data that matches my understanding of your data. Perhaps your people do not run so many machines at the same time but I wanted to test my macro thoroughly.
The macro creates a copy of this worksheet (in case you do not want it sorted) and names it Temp. It then sorts Temp by Name and Sign-on time to give:
The macro compares adjacent rows and copies overlaps to worksheet Overlap:
Finally it deletes worksheet Temp.
My objective was to fully explain what the code does but not how the macro does it. Once you know a statement exists, it is usually easy to look it up. Come back with questions if necessary but the more you can decipher for yourself the faster you will develop your skills.
Option Explicit
Sub FindOverlap()
Dim RowOverCrnt As Long
Dim RowTempCrnt As Long
Dim RowTempLast As Long
Dim WithinOverlap As Boolean
Dim WshtLog As Worksheet
Dim WshtOver As Worksheet
' My principle reason for using worksheet objects is so the names appear in a single place.
Set WshtLog = Worksheets("Log") ' Change Log to your name for the source worksheet
Set WshtOver = Worksheets("Overlap") ' Change Log to your name for the destination worksheet
' Create temporary copy of worksheet "Log" in case sequence must be preserved.
' This is not necessary if you do not care if worksheet Log is sorted.
WshtLog.Copy After:=Sheets(Worksheets.Count)
Sheets(Worksheets.Count).Name = "Temp"
' Clear any existing data from destination worksheet and copy the headings from the
' source worksheet
With WshtOver
.Cells.EntireRow.Delete
WshtLog.Rows(1).Copy Destination:=.Range("A1")
End With
RowOverCrnt = 2 ' First to which rows from worksheet Log will be copied
' Sort worksheet Temp by Name and Sign-in time
With Worksheets("Temp")
With .Cells
.Sort Key1:=.Range("A2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End With
' This is the VBA equivalent of selecting the cell at the bottom of column A
' and clicking Ctrl+Up. With the keyboard, this move the cursor up to the first
' cell with a value and selects that cell. That is, it selects the last cell from
' the top with a value. This statement sets RowTempLadst to the row number of that
' cell.
RowTempLast = .Cells(Rows.Count, "A").End(xlUp).Row
WithinOverlap = False ' Not currently within a set of rows that overlap.
' I assume row 2 is the first data row. This loop checks a row for an overlap with
' the previous row. This is why the start row is 3.
For RowTempCrnt = 3 To RowTempLast
If .Cells(RowTempCrnt, "A").Value = .Cells(RowTempCrnt - 1, "A").Value And _
.Cells(RowTempCrnt, "B").Value < .Cells(RowTempCrnt - 1, "C").Value Then
' The current row and the previous row are for the same person and
' the start time of the current row is before the end time of the previous row
If WithinOverlap Then
' Previous rows have overlapped and have been copied to worksheet Overlap.
' Add current row to end of current set of overlaps
.Rows(RowTempCrnt).Copy Destination:=WshtOver.Cells(RowOverCrnt, "A")
RowOverCrnt = RowOverCrnt + 1 ' Advance to next free row
Else
' The current and previous rows overlap. Copy both to worksheet Overlap.
.Rows(RowTempCrnt - 1 & ":" & RowTempCrnt).Copy _
Destination:=WshtOver.Cells(RowOverCrnt, "A")
RowOverCrnt = RowOverCrnt + 2 ' Advance to next free row
WithinOverlap = True ' Record within overlap set
End If
Else
' Current row does not overlap with previous
If WithinOverlap Then
' An overlap set has ended
RowOverCrnt = RowOverCrnt + 1 ' Leave gap between overlap sets
WithinOverlap = False ' Record no longer within overlap set
End If
End If
Next RowTempCrnt
End With
' Delete worksheet Temp
' "Application.DisplayAlerts = False" suppresses the "Are you sure you want to delete
' this worksheet?" question.
Application.DisplayAlerts = False
Worksheets("Temp").Delete
Application.DisplayAlerts = True
End Sub

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.

Determine number of columns in printed page

In Excel 2007, I have a worksheet that only contains data in a only few cells (well within one page wide/tall). For illustration, say the worksheet only contains data in cell A1. How can I use VBA to determine the number of columns that fit in a single printed page? Said another way, how can I determine the column furthest to the right in which I could add data and NOT cause an additional sheet to print. A couple of additional comments:
I am not setting a print area. If I were, then I'd just use the same
range...but I'm not.
I can't use UsedRange, because the used range is much smaller than
what actually fits in the width/height of a printed page.
I can't use ActiveWindow.VisibleRange because it isn't limited to a
single page width/height.
I've searched and searched, but cannot find a solution to accomplish this seemingly simple task. I mostly found scenarios that involved UsedRange, VisibleRange, and the print area, but those don't help me.
EDIT
Here's the final version of the function I'm using, which is a slight tweak of the selected answer.
Public Function GetLastColumnBeforeVPageBreak( _
ByRef ws As Worksheet, _
ByVal aVPageBreakNum As Long) As Long
Dim isMod As Boolean
isMod = False
On Error GoTo ErrorHandler
GetLastColumnBeforeVPageBreak = ws.VPageBreaks(aVPageBreakNum).Location.Column - 1
' If necessary, delete the last column with dummy data and reset UsedRange.
If isMod Then
ws.Cells(ws.Rows.Count, ws.Columns.Count).EntireColumn.Delete
r = ws.UsedRange.Rows.Count
End If
Exit Function
ErrorHandler:
If Err.Number = 9 Then
' Subscript out of range.
' Ensure there is more than one page by putting something in last cell.
isMod = True
ws.Cells(ws.Rows.Count, ws.Columns.Count).Value = 1
Err.Clear
Resume
Else
Err.Raise Err.Number
End If
End Function
I was sure there was a worksheet property around page breaks so I hit F2 in the IDE to open the object browser and searched on pagebreak. A little bit of F1'ing showed there is a Worksheets(1).VPageBreaks(1).Location property that returns a range object. The left side of the range aligns with the 1st vertical page break so:
LastColOnP1 = Worksheets(1).VPageBreaks(1).Location.Column - 1
will give you a variable containing the number of the last column that will print on page 1 of your 1st sheet.
Or within a procedure:
Sub FindFirstVPageBreak()
Dim LastColOnP1 As Long
With ActiveSheet
'Ensure there is more than one page by puting something in last column
.Cells(1, .Columns.Count) = 1
LastColOnP1 = .VPageBreaks(1).Location.Column - 1
'Delete the last column to allow UsedRange to be reset
.Cells(1, .Columns.Count).EntireColumn.Delete
End With
'Save to workbook to commit the reset UsedRange
If Not ActiveWorkbook.ReadOnly Then
ActiveWorkbook.Save 'assumes workbook has been saved previously.
End If
End Sub
You can use Columns(x).ColumnWidth to calculate (iif column contains data). See http://EzineArticles.com/7305778 for a much more detailed solution.