I have a vba script which is supposed to copy data from one sheet to another. It does by means of three nested for loops. Stepping through the code in debugging these appear to work perfectly, but when the vba script is run they appear to stop too early. Otherwise the vba script works.
I have been staring at this for hours and cannot for the life of me see what would cause the loops to stop early. I'm hoping the solution is something simple I've missed, but I am at a genuine loss, not for the first time since I started this.
The sheet is organised as follows:
Sheet1, contains the data to be copied.
Each row contains a seperate response, of which there are 55 in the test data
The sheet contains nine blocks of data, named Episode 1-9. Each episode contains column where an integer represent a start, end and interval time.
In the test data each episode is identical except for the start/end times.
The maximum value for EndTime is 36
The test data is over the first four Episode blocks only, so Episode4 contains EndTime=36 for each row
Sheet2, where the data is to go
-First column contains each RespondentID copied over 36 rows
-Second column contains numbers 1-36, thus representing that time slot for that respondent
-11 Columns after that contain the area where the data copied from sheet1 for that Respondent/Time is put. These 36x11 areas are named "Response1-55" in the test data
The logic of the vba script is as follows:
Counters:
- n counter for number of respondents
- r counter for number of episodes
- i counter for rows within the responses being copied to.
->For each response (starting with n=1 to Respondents)
--> Select the first episode (Starting with r=1 to 9)
--->For each episode
--->Read the start, end and interval times
--->Starting from i = Start to i=End copy the relevant cells from the n'th row of the r'th episode
--->Copy those cells to the i'th row of the current response on sheet2
--->When you reach the EndTime of the current episode, go to the next one (next r)
-->If the episode you just finished has 36 as its EndTime then go to the next response, or continue till you run out of episodes.->Next Response
In debugging the code appears to do exactly this.
However when I run the vba script on the test sheet it works only for episodes 1 and 2. The data from episodes 3 and 4 is not copied. Nothing is copied in its place, and the data which IS copied is correct in every respect. There are no error messages at any point.
If anyone could suggest why this might be happening I would build unto them an actual church. The answer could also be added here: https://stackoverflow.com/questions/119323/nested-for-loops-in-different-languages Which does not yet have a section for VBA.
A link to the test sheet is here: http://dl.dropbox.com/u/41041934/MrExcelExample/TornHairExampleSheet.xlsm
The relevant part of the code is here
Sub PopulateMedia()
Application.ScreenUpdating = False
'Count the total number of response rows in original sheet
Dim Responses As Long, n As Integer, i As Integer, r As Integer
Responses = (Sheets("Sheet1").UsedRange.Rows.Count - 3) ' equals 55 in test sheet
'For each response...
For n = 1 To Responses
i = 1 'Reset i for new response
Dim curr_resp As Range
Set curr_resp = Sheets(2).Range("Response" & n) 'Define a range containing all response data
For r = 1 To 9 'For each episode...
Dim curr_ep As Range 'Define a range containing episode data for all responses
Set curr_ep = Sheets(1).Range("episode" & r)
Dim Stime As Integer, Etime As Integer, Itime As Integer 'Variables contain start, end and inter-episode times
Stime = curr_ep.Cells(n, 1)
Etime = curr_ep.Cells(n, 17)
Itime = curr_ep.Cells(n, 19)
For i = Stime To (Etime + Itime) 'for each time-slot...
If i <= Etime Then
Dim a As Variant
a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
curr_resp.Rows(i) = a 'Copy data from above current episode to current response for slots between Stime and Etime
End If
Next i
If Etime = 36 Then Exit For
Next r
Next n
Application.ScreenUpdating = True
End Sub
To disclose, I have already had help on this project from this site, VBA copy from a union of two ranges to a row of another range but the code has been changed slightly since then and this is a different problem.
Once more, thank you enormously for any help which might come of this. I have been staring at this for hours and do not see where the error is. Any guidance at all greatly appreciated.
I would post this as a comment if I could but this is too long. So here it is as a query /potential solution
I think your range references are the issue
The code below is a cut-down version of your code
curr_ep is a named range of episode1. It has a range address of $Y$4:$AQ$58
When you loop through the a variant you are setting a range with this syntax
a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
which is equivalent to
a = curr_ep.Range("Y2:AQ2")
which means you are actually looking at AW2:BG2 not Y2:AQ2 which is what I think you may have intended, i.e. you are building in an unintended offset
Sub PopulateMedia()
n = 1
r = 1
Dim curr_ep As Range
Dim curr_test As Range
Set curr_ep = Sheets(1).Range("episode" & r)
Set curr_test = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
End Sub
Related
I've been searching for a way to concatenate my Excel (or any other tool/software handling tables) rows based on common cells. As an example:
I have this tab-stop divided table. Each of the values is in a separate row:
angeb* 12 16 18
zyste* 60 61
zynisch* 12
zyste* 60
abstreit* 70
anflunker* 70
angeb* 70
I want to concatenate the rows in a way that the result would be:
angeb* 12 16 18 70
zyste* 60 61
zynisch* 12
abstreit* 70
anflunker* 70
It does work by doing as proposed in this tutorial, but it only concatenates single cell values into another single cell. I also tried going the path basically proposed by this so question and finally leading me to VLOOKUP (description). But they all concatenate in cells.
Basically pretty simple, I need to merge cells with the same Column 1, but keep the columns, just concatenate beyond. The second row can then be deleted, once it is added to the first one. I tried adapting the above scripts, but I could not make it work in one step, just with then converting comma separated values into cells and copying them to new columns. I am not an expert with VBA, but this seems like a very simple functionality, I might as well be missing something. Any help is greatly appreciated.
I have written and color-coded each part of what I did, but here is the general method:
Sort all data A-Z
Use a CountIf statement to count how many times a particular data row shows up.
Assuming 3 columns of data, find MAX() of MaxRows, multiply (here, 3 columns x 2 Rows maximum observed = 6 data max).
Copy the labels, remove duplicates [Green] so you have a condensed table.
Use IndexMatch equations, coupled with IF and IFERROR statements to re-sort the data. Note the +1 for Columns P-Q)
Problem - you can still get a gap, but it's all in the same rows now!
Here's a quick Youtube video on how I did it.
TSpinde Answer 1
I was a little confused by your question so I only concatenated names that were exactly the same.
So the way my code works is it makes an array of tags and when it runs into one that it already has it looks for the next empty slot in the original row. It then adds the value in and does this until it hits an empty cell in the new row. There's a bit of funny business with decreasing the lastrow value and changing the row it's on, but its necessary for it to move to the correct row of data in the next cycle.
This macro assumes that all possible data entries are side by side, for example there wont be a value in C2 and E2 if D2 is empty.
Sub macro()
Dim LastRow As Long
Dim LastCol As Long
Dim TagArray() As String
Dim count As Long
Dim i As Long
Dim j As Long
Dim PreExisting As Boolean
Dim Targetrow As Long
ReDim TagArray(1 To 1)
LastRow = Worksheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Worksheets(1).Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
TagArray(1) = Worksheets(1).Range("A1").Value
For i = 2 To LastRow
PreExisting = False
For j = 1 To UBound(TagArray)
If Worksheets(1).Cells(i, 1) = TagArray(j) Then
PreExisting = True
Targetrow = j
Exit For
End If
Next j
If PreExisting Then
For j = 2 To LastCol
If Not IsEmpty(Worksheets(1).Cells(i, j)) Then
For count = 1 To LastCol
If IsEmpty(Worksheets(1).Cells(Targetrow, count)) Then
Worksheets(1).Cells(Targetrow, count) = Worksheets(1).Cells(i, j)
Exit For
Else
If count = LastCol Then
LastCol = LastCol + 1
Worksheets(1).Cells(Targetrow, LastCol) = Worksheets(1).Cells(i, j).Value
End If
End If
Next count
Else
Exit For
End If
Next j
Worksheets(1).Rows(i).Delete
LastRow = LastRow - 1
i = i - 1
Else
ReDim Preserve TagArray(1 To UBound(TagArray) + 1)
TagArray(UBound(TagArray)) = Worksheets(1).Cells(i, 1)
End If
Next i
End Sub
Hopefully, you find this useful if you wanted to use it in VBA instead of worksheet functions.
I have about 30 sheets each representing a day of the week. This would save me a huge amount of time.
I have had a look in this room for problem similar to mine, but I have had no luck.
I am keen to get some help.
So the problem; I have tried to amend the below code but with no luck as I get error messages.
I am trying to copy the same data, with a slight twist.
However I want the date column, "A" which is the "same date" for each cell from A2-A85, when its pasted it goes up by 1 day every time.
The end outcome should be 7 different days consecutively when it is pasted 7 times but each time its going up.
At this moment the code allows me to copy and paste 7 times the same data.
Your help and insight would be appreciated
' this is just one sheet
Sub CopyRange()
Dim rws As Long
Sheets("20160817").Activate
With Worksheets("20160817").Range("A2:O85")
rws = .Rows.Count + 2
.Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 7)
End With
End Sub
Many thanks,
Please note, in order to get the ranges for these thirty sheets, I have had to use the concantation function and count, to work out the number of rows for each sheet. The columns is fixed A-O. In order to work out my range code.
Kind regards
Ali
Col
A B C D .......O
16/9 Data1B Data1C Data1D
16/9 Data2B Data2C Data2D
.
.
16/9 Data2B Data2C Data2D
code run
Col
A B C D .......O
17/9 Data1B Data1C Data1D
17/9 Data2B Data2C Data2D
.
.
17/9 Data2B Data2C Data2D
Continues X times the date going up by one from the previous date
try this
Sub CopyRange()
Dim rws As Long
With Worksheets("20160817").Range("A2:O85")
rws = .Rows.Count + 2
With .Resize(rws)
.Copy Destination:=.Offset(rws).Resize(rws * 7)
.Offset(rws).Resize(rws * 7, 1).SpecialCells(xlCellTypeConstants, xlNumbers) = "=R[-86]c+1"
End With
End With
End Sub
BTW, you don't need any Activate
I am trying to loop through a price column to see if the cell has a price. If it is empty then I want it to pop up a message box that there is no price and if there is a price, call the transfer data code. Right now, I am infinitely looping through the message box. Here is my code so far:
Private Sub Check_Price_Click()
'Declared variable to read the specific column
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "BB").End(xlUp).Row
j = 2
For i = 2 To N
If IsEmpty(Cells(i, "BB")) Then
MsgBox ("There is no Price")
Else
Call Transfer_data_Click
End If
Next i
End Sub
If your data ends at row 10, so the last price is in BB10, then you would expect the code above to run 9 times - for rows 2 through 10. In a brand new spreadsheet, it worked just fine for me, but if this wasn't a brand new spreadsheet it would be VERY easy for it to start doing exactly what you describe.
If I go down to row 20 and type a space in cell BB20 it will loop from 2 through 20 with everything after 10 giving the pop up message. If you have a cell that looks empty, but isn't, way down the list, it would seem like it is an infinite loop.
Is there another column that will always have data? If so, I would suggest the following:
(In this example I am using column BA as my column that will always have data.)
Sub example()
Dim n As Range
Set n = Range("BB2")
'Loop as long as the length of the value in column BA is greater than 0
Do While Len(Cells(n.Row(), "BA").Value) > 0
If IsEmpty(n) Then
MsgBox ("There is no Price")
Else
Call Transfer_data_Click
End If
'set n as the cell under the current n
Set n = n.Offset(1, 0)
Loop
End Sub
I'm working with an Excel report in which each month a new worksheet is added. Each row in the worksheet is for an employee, and the columns in that row is data related to them. Each week, the rows may vary, with names being added and removed.
I wrote the following VBA module to align the rows of 2 worksheets, adding blank rows as necessary, but I need to figure out a way to expand that so it aligns 12 worksheets, with multiple blank spaces between names as necessary. I'm not sure how to go about this, any suggestions?
Option Explicit
Sub Align()
Dim n As Long, a As Range, c As Range, x As Long
n = Cells.SpecialCells(11).Row
Set a = Worksheets("Jan").Range("A6:A200"): Set c = Worksheets("Feb").Range("A6:A200")
a(n + 1) = Chr(255): c(n + 1) = Chr(255)
a.Sort a(1), 1, Header:=xlNo
c.Sort c(1), 1, Header:=xlNo
Do
x = x + 1
If a(x) > c(x) Then
a(x).EntireRow.Insert xlShiftDown
ElseIf a(x) < c(x) Then
c(x).EntireRow.Insert xlShiftDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x) = Chr(255) And c(x) = Chr(255)
a(x).ClearContents: c(x).ClearContents
End Sub
I do not believe any simple rearrangement of your existing code will meet your needs. I also believe this is too big a question to expect anyone to create an entire macro for you.
Below I outline the approach I would take to solving your problem. I suggest you try to solve each issue in turn. None of the code I give has been tested so I doubt it is error-free. Debugging my code should help you understand it. If you run into difficulties, you can come back to me with questions. However, it would be better to attempt to construct a new question including the code you cannot get working. With a single issue question, I believe you will get help more quickly than waiting for me to log in.
I hope this helps.
Issue 1 - Identifying the 12 worksheets
If the workbook only contains the 12 worksheets "Jan", "Feb" ... "Dec", then it is easy: worksheets 1 to 12. It does not matter if they are in the wrong sequence.
If the workbook contains other worksheets that are the first few worksheets of the workbook then it will be almost as easy: N to N+11.
If the other worksheets and the month worksheets are muddled, you will have to access then using an approach like this:
Dim InxMonth As Long
Dim InxWsht As Long
Dim WshtMonthName() As Variant
WshtMonthName = Array("Jan", "Feb", ... "Dec)
For InxMonth = 0 to 11
InxWsht = WshtMonthName(InxMonth)
With Worksheets(InxWsht)
:::::::
End with
Next
It might be better to use this approach anyway in case a user adds a new worksheet. This technique will work regardless of what other worksheets may exist.
Issue 2 - Get sorted list of names
You need a list in alphabetic order containing every name that appears in any worksheet. I can think of a number of approaches. I was taught: get the code working then make it faster, smoother or whatever. I have picked an approach that I think is easy to implement. Other approaches would be faster to execute but it does not sound as though you will be executing the code very often and there are only 12 worksheets. Your taking hours to debug complex code that will shave a few seconds off the run time is not a good use of your time.
Issue 3 - Sort the worksheets
You have code to sort a single worksheet. You need to put that code in a loop which you execute for each of the month worksheets.
Issue 4 - Create list of names
This approach is not very elegant and I can think of much faster approaches. However I think it is easy to understand what this code is doing.
I have initialised NameList to 200 entries because your code seem to assume that there are fewer than 200 employees. However the code enlarges the array if necessary.
Dim InxNameCrntMax as Long
Dim InxMonth As Long
Dim InxWsht As Long
Dim NameList() As String
Dim NextLowestName As String
Dim RowCrnt As Long
Dim WshtRowCrnt() As Long
ReDim NameList(6 to 200) ' 6 is first data row
InxNameCrntMax = 0
ReDim WshtRowCrnt(0 To 11)
' For each worksheet set the current row to the first data row
For InxMonth = 0 to 11
WshtRowCrnt(InxMonth) = 6
Next
Do While True
' Loop until every name in every worksheet has been added to NameList
NextLowestName = "~" ' Greater than any real name
' Examine the next row in each worksheet and find the lowest name
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxMonth) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") <> "" Then
' Not all names from current worksheet added to NameList
If NextLowestName > .Cells(RowCrnt, "A") Then
' This name comes before previous next lowest name
NextLowestName = .Cells(RowCrnt, "A")
End If
End If
End With
Next
If NextLowestName = "~" Then
' All names from all worksheets added to NameList
Exit Do
End If
' Add NextLowestName to NameList
InxNameCrntMax = InxNameCrntMax + 1
If InxNameCrntMax > UBound(NameList) Then
' NameList is full so enlarge it
ReDim Preserve NameList(6 To UBound(NameList) + 100)
End If
NameList(InxNameCrntMax) = NextLowestName
' Step the current row for every worksheet containing NextLowestName
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxWsht) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") = NextLowestName Then
WshtRowCrnt(InxWsht) = RowCrnt + 1
End If
End With
Next
Loop
Issue 5 - Using NameList
I initialised the size of NameList to (6 To 200) although it may have been enlarged so it could now be (6 To 300) or (6 To 400).
VBA is one of the few languages that does not require the lower bound of an array to be 0. It is worth taking advantage of this feature. I understand from your code that 6 is the first data row of the worksheets. That is why I set the lowest bound to 6; it means the element numbers match the row numbers.
InxNameCrntMax is the last used entry in NameList so we have something like:
NameList(6) = "Aardvark, Mary"
NameList(7) = "Antelope, John"
NameList(8) = "Bison, Jessica"
::::::
NameList(InxNameCrntMax) = "Zebra, Andrew"
So if for Worksheets("Jan") there is no Mary Aardvark, row 6 should be empty. If there is a John Antelope, his data belongs on row 7.
In your code, you use InsertRow to insert blank lines. I do not really like updating worksheets in situ because, if you mess up, you have to reload the data from a backup copy.
I would rather build worksheet "JanNew" from Jan", "FebNew" from "Feb" and so on. When all these new worksheets had been created, I would rename "Jan" to "JanOld" and so on and then I would rename "JanNew" to "Jan" and so on. Only when I was absolutely convinced I had moved the data correctly would I delete the old worksheets.
However, I have to admit your approach is easier. I leave you to decide what to do.
I've pieced together a macro to allow me to calculate the cost of a story task by calculating the specific rate based on the developer assigned. I have the rate table on a second sheet. I am able to get a result for the cell that the macro is set to (Row 2), but want it to run on all rows. I know I have to set a generic range, but am not sure. How should I change the range declare to run on all rows?
Here is the code:
Sub GetCost()
Range("D2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Dim Estimate As Integer, Assignee As String, RodRate As Integer, GarthRate As Integer, DerekRate As Integer, TotalCost As Integer
Estimate = ThisWorkbook.Worksheets("Sheet1").Range("D2").Value
Assignee = ThisWorkbook.Worksheets("Sheet1").Range("E2").Value
RodRate = ThisWorkbook.Worksheets("Sheet2").Range("B2").Value
GarthRate = ThisWorkbook.Worksheets("Sheet2").Range("B3").Value
DerekRate = ThisWorkbook.Worksheets("Sheet2").Range("B4").Value
If Assignee = "Rod" Then
TotalCost = Estimate * RodRate
ElseIf Assignee = "Garth" Then
TotalCost = Estimate * GarthRate
ElseIf Assignee = "Derek" Then
TotalCost = Estimate * DerekRate
Else
TotalCost = "0"
End If
ThisWorkbook.Worksheets("Sheet1").Range("F2").Formula = TotalCost
ActiveCell.Offset(1, 0).Select
Loop
End Sub
I have rewritten your code with explanations which I hope are enough for you to understand why. There is much more that I could say. I hope this is a good balance between too little and too much.
However, I have to point out that there are some excellent project management tools available. I do not believe this is a good use of your time.
Random points
On 32-bit computers, Long is better than Integer.
Do not declare your variables inside a loop. The scope of a variable declared inside a sub-routine is the
the sub-routine so declare them at the top of the sub-routine.
You can declare all your variables in a single Dim statement but I find it confusing unless there is a real association between two or more variable. I might have:
Dim RodRate As Long, GarthRate As Long, DerekRate As Long
because these variables are associated. However the trouble with this approach is that you will have to add MaryRate and JohnRate and AngelaRate when these people join your project.
You need an array:
Dim PersonRate(1 To 3) As Long
where PersonRate(1) = Rate for Rod, PersonRate(2) = Rate for Garth and PersonRate(3) = Rate for Derek.
But this is hardly any better. You want a table that can grow. So today:
Name Rate
Rod 20
Garth 25
Derek 15
Next week:
Name Rate
Rod 20
Garth 25
Derek 15
Mary 30
With this, you pick up the Assignee's name, run down the table until you find their name then look across for their rate.
I assume you have a table like this in Sheet2. You could keep going back to Sheet2 but better to load the table into an array.
We could have:
Dim PersonName() As String
Dim PersonRate() As Long
so PersonRate(2) gives the rate for PersonName(2).
Note in my first array declaration I wrote: PersonRate(1 To 3). This time, the brackets are empty. With PersonRate(1 To 3), I am saying I want exactly three entries in the array and this cannot be changed. With PersonRate(), I am saying I want an array but I will not know how many entries until run time.
I said we could have two arrays, PersonName() and PersonRate() and this is what I have done. This is an easy-to-understand approach but I do not think it is the best approach. I prefer structures. When you have got this macro working and before you start your next look up User Types which is the VBA name for a structure.
Consider:
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
End With
There is a lot to explain here.
Cells means I want to address a cell within the active workbook. .Cells means I want to address a cell within the sheet identified in the With statement. This means I do not have to select Sheet1 or Sheet2 to look at their contents. Selecting worksheets is slow and the code tends to be more difficult to understand.
.Cells(Row, Column) identifies a cell. Row must be a number but column can be a number or a column code: A=1, B=2, Z=26, AA=27, etc.
Rows.Count returns the number of rows in a sheet for the version of Excel you are using. So .Cells(Rows.Count, "A") identifies the bottom of column "A".
End(xlUp) is the VBA equivalent of clicking Ctrl+UpArrow. If you are not familar with Ctrl+Arrow I suggest you play with these four controls. Note, these controls give easy to understand results with a rectangular table. However, if there are empty cells, the results can be strange.
Putting this together: .Cells(Rows.Count, "A").End(xlUp).Row means start at the bottom of column A, go up until you hit a cell with a value and return its row number. So this sets RowMax to the last row of the Rate table. When you add row 5 with Mary's name and rate, this code will automatically adjust.
Revised code
This should be enough to get you started. Welcome to the joys of programming.
' * Require all variables to be declared which means a misspelt name
' is not taken as an implicit declaration
Option Explicit
Sub GetCost()
Dim Estimate As Integer
Dim Assignee As String
Dim TotalCost As Integer
Dim PersonName() As String
Dim PersonRate() As String
Dim InxPerson As Long
Dim RowCrnt As Long
Dim RowMax As Long
' You can declare constants and use them in place of literals.
' You will see why later. I could have made these strings and
' used "A", "B", "D", "E" and "F" as the values. Change if that
' is easier for you.
Const ColS2Name As Long = 1
Const ColS2Rate As Long = 2
Const ColS1Estimate As Long = 4
Const ColS1Assignee As Long = 5
Const ColS1Total As Long = 6
' Before doing anything else we must load PersonName and PersonRate from
' Sheet2. I assume the structure of Sheet2 is:
' A B
' 1 Name Rate
' 2 Rod 20
' 3 Garth 25
' 4 Derek 15
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, ColS2Name).End(xlUp).Row
' I now know how big I want the the name and rate arrays to be
ReDim PersonName(1 To RowMax - 1)
ReDim PersonRate(1 To RowMax - 1)
' Load these arrays
For RowCrnt = 2 To RowMax
' I could have used 1 and 2 or "A" and "B" for the column
' but this is easier to understand particularly if you come
' back to this macro in six month's time.
PersonName(RowCrnt - 1) = .Cells(RowCrnt, ColS2Name).Value
PersonRate(RowCrnt - 1) = .Cells(RowCrnt, ColS2Rate).Value
Next
End With
With Sheets("Sheet1")
' I am using the same variable for rows in sheets Sheet1 and Sheet2.
' This is OK because I never look at Sheet1 and Sheet2 at the same time.
RowCrnt = 2
Do Until IsEmpty(.Cells(RowCrnt, ColS1Estimate))
Estimate = .Cells(RowCrnt, ColS1Estimate).Value
Assignee = .Cells(RowCrnt, ColS1Assignee).Value
.Cells(RowCrnt, ColS1Total).Value = 0
' Locate the Assignee in the PersonName array and
' extract the matching rate
For InxPerson = 1 To UBound(PersonName)
If PersonName(InxPerson) = Assignee Then
.Cells(RowCrnt, ColS1Total).Value = Estimate * PersonRate(InxPerson)
Exit For
End If
Next
RowCrnt = RowCrnt + 1
Loop
End With
End Sub
Tony's answer is a great solution and introduction to programming and very well written so I've +1 it. However unless I'm missing something code should always be the last resort in excel as it is very slow compared to formulas, I would have thought that a simple lookup would suffice, something like:
=D2*(vlookup(E2,'sheet2'!A:B,2,FALSE))
Copied down the column