I'm working on a spreadsheet that has 17 sheets, with sheets 2-16 containing invoice data I am interested in.
As an example, if a person's name in column 4 of Sheets(2) appears in Sheets(1), then I want to sum the amount of money they have charged (which is found in column 10 of Sheets(2)). Spreadsheets 2-16 are laid out exactly the same, except they contain a different number of entries and the data is different.
There are three $ sums I am interested in computing and then displaying at the top of each sheet: two sums of money represent two different divisions, and the last is simply the total (w_sum, smb_sum, and total)
The problem I'm having is that every sheet displays the sums from Sheets(2), and not their own. However, when I remove the outer For loop and manually change the sheet number, I get the correct values. I hope I'm being clear with my question, and I would greatly appreciate any help. I just started playing around with VBA the other day, so I'm not too familiar with the syntax, but I think my logic is right or almost right.
Sub GetSums()
Dim i As Integer
Dim j As Integer
Dim w_sum As Currency
Dim smb_sum As Currency
Dim total As Currency
w_sum = 0
smb_sum = 0
total = 0
i = 15
For j = 2 To 17
Sheets(j).Activate
Do Until Cells(i, 6).Value = 0
If Not IsError(Application.Match(Cells(i, 4).Value, Sheets(1).Range("D2:D91"), 0)) Then
w_sum = w_sum + Cells(i, 10).Value
End If
If Not IsError(Application.Match(Cells(i, 4).Value, Sheets(1).Range("E2:E91"), 0)) Then
smb_sum = smb_sum + Cells(i, 10).Value
End If
total = total + Cells(i, 10).Value
i = i + 1
Loop
Cells(10, 4).Value = w_sum
Cells(11, 4).Value = smb_sum
Cells(12, 4).Value = total
Next j
End Sub
You can declare variable as worksheet:
Dim ws As Worksheet
Then instead of calling Sheets(j).Activate, you can bind ws to sheet number j:
Set ws = Sheets(j)
Then you can use ws.cell(i, 4).value instead of just cells(i, 4).value which tends to behave arbitrarily.
Hope this helps
Related
I'm writing a VBA code for a workbook with 7 pages. Each page has stock data in the same layout. Each stock is identified with a ticker, and has data for opening, closing, high, low, and volume for each day of the year.
I want a code that will create a new column for the ticker, and beside that columns for Yearly Change, Percent Change, and Total Volume.
I want to be able to run the macro once and have it loop through every page for the workbook. It will label the ticker and calculate the Total Stock Volume on each page, but it only calculates the Yearly Change and Percent Change for the last page.
This is what should happen on each page
This is what all but the last page look like
As you can see from the images, it's doing part of the code on each page, but only the last page gets the entire code applied thereto.
Could anyone tell me what's going on or give me a hint? The macro is definitely running through each page since columns I and L are getting done, but columns J and K are only done on the last page.
Here is the code I'm using:
Sub Stocks()
'This creates a "worksheet loop" that will automatically cycle through each page of the workbook and apply the macro thereto.
Dim sheets As Worksheet
For Each sheets In ThisWorkbook.Worksheets
sheets.Activate
'The proceeding lines create the column headings, as well as the headings horizontal headings used to show the greatest and least perchange change as well as the greatest total volume.
Range("I1").Value = "Ticker"
Range("J1").Value = "Yearly Change"
Range("K1").Value = "Percent Change"
Range("L1").Value = "Total Stock Volume"
Range("P1").Value = "Ticker"
Range("Q1").Value = "Value"
Range("O2").Value = "Greatest % Increase"
Range("O3").Value = "Greatest % Decrease"
Range("O4").Value = "Greatest Total Volume"
Range("O5").Value = "Least Total Volume"
'This creates a variable which will identify and label the stock ticker.
Dim stock_ticker As String
'This creates a variable which will hold the total stock volume.
Dim stock_volume As Double
stock_volume = 0
'This variable is used to input the ticker value in the correct cell in column I. The ticker changes at a faster rate in column I than in column A. This variable is therefore used to adjust the rate tickers are copied over from column A to column I.
Dim j As Integer
j = 2
'This loop checks to see if the value in cell 'Ax" is equal to "Ay", where x and y are integers, and y=x+1. If they are equal, Excel will recognize the tickers as being the same, and add the stock volume in the xth row to an accumlative total stock volume. If Ax does not equal Ay, Excel will recognize that the ticker just changed. When this happens, Excel will will add the last stock volume for the current ticker to the accumlative total stock volume; then it will identify what the current ticker is and insert this into column I, insert the total stock volume for that ticker into column L, then reset the total stock volume back to 0, then repeat the process.
For i = 2 To 43398
If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
stock_volume = stock_volume + Cells(i, 7).Value
ElseIf Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + Cells(i, 7).Value
Cells(j, 9).Value = Cells(i, 1).Value
Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
Next i
Dim stock_year_start As Double
Dim stock_year_end As Double
Dim stock_year_change As Double
Dim stock_percent_change
Dim k As Integer
k = 2
For i = 2 To 43398
If Right(Cells(i, 2), 4) = "0101" Then
stock_year_start = Cells(i, 3)
ElseIf Right(Cells(i, 2), 4) = "1231" Then
stock_year_end = Cells(i, 6)
stock_year_change = stock_year_end - stock_year_start
stock_percent_change = stock_year_change / stock_year_start
Cells(k, 10).Value = stock_year_change
If Cells(k, 10).Value > 0 Then
Cells(k, 10).Interior.ColorIndex = 4
ElseIf Cells(k, 10).Value < 0 Then
Cells(k, 10).Interior.ColorIndex = 3
End If
Cells(k, 11).Value = stock_percent_change
k = k + 1
End If
Next i
Range("K1").EntireColumn.NumberFormat = "0.00%"
'The proceeding lines automatically resize the cells created throughout the program to fit the content therein.
Dim sheet_name As String
sheet_name = ActiveSheet.Name
Worksheets(sheet_name).Columns("I:L").AutoFit
Worksheets(sheet_name).Columns("O:Q").AutoFit
'This cycles to the next page in the workbook and repeats all the code hitherto.
Next sheets
End Sub
I would avoid dimming variables with object names, so consider changing the Sheets in Dim sheets as Worksheet to ws.
To loop through sheets and apply the same logic you need to do something like this:
Dim ws as Worksheet
For Each ws in Worksheets
'Your code goes here with all objects referring to current ws like so:
ws.Range(....
ws.Cells(....
Next ws
Do not activate the sheet. Instead, qualify every object (Range, Cells, etc) with the variable ws. I would use a find & replace and swap Range with ws.Range and then swap Cells with ws.Cells. It would look something like this in your code.
Sub Stocks()
Dim stock_ticker As String, stock_volume As Double, j As Integer
Dim ws As Worksheet
For Each ws In Worksheets
ws.Range("I1").Value = "Ticker"
ws.Range("J1").Value = "Yearly Change"
ws.Range("K1").Value = "Percent Change"
ws.Range("L1").Value = "Total Stock Volume"
ws.Range("P1").Value = "Ticker"
ws.Range("Q1").Value = "Value"
ws.Range("O2").Value = "Greatest % Increase"
ws.Range("O3").Value = "Greatest % Decrease"
ws.Range("O4").Value = "Greatest Total Volume"
ws.Range("O5").Value = "Least Total Volume"
stock_volume = 0
Dim j As Integer
j = 2
For i = 2 To 43398
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
Next i
I found the problem. Most stocks end on 12/30, and I was only checking for 12/31. I have rewritten the second loop as:
For i = 2 To 43398
If Right(workbook_sheet.Cells(i, 2), 4) = "0101" Then
stock_year_start = workbook_sheet.Cells(i, 3)
ElseIf Right(workbook_sheet.Cells(i, 2), 4) = "1231" Then
stock_year_end = workbook_sheet.Cells(i, 6)
stock_year_change = stock_year_end - stock_year_start
stock_percent_change = stock_year_change / stock_year_start
workbook_sheet.Cells(k, 10).Value = stock_year_change
ElseIf Right(workbook_sheet.Cells(i, 2), 4) = "1230" Then
stock_year_end = workbook_sheet.Cells(i, 6)
stock_year_change = stock_year_end - stock_year_start
stock_percent_change = stock_year_change / stock_year_start
workbook_sheet.Cells(k, 10).Value = stock_year_change
If workbook_sheet.Cells(k, 10).Value > 0 Then
workbook_sheet.Cells(k, 10).Interior.ColorIndex = 4
ElseIf workbook_sheet.Cells(k, 10).Value < 0 Then
workbook_sheet.Cells(k, 10).Interior.ColorIndex = 3
End If
workbook_sheet.Cells(k, 11).Value = stock_percent_change
k = k + 1
End If
Next i
I'm thinking of a more elegant way of finding the year-end stock value. The 43398 is also a temporary value, as each page has a different number of stocks to check for and I'm still looking for a while to find the number of rows in each field.
I'll leave this here in case anyone wants to comment.
I'm trying to implement a nested for and a nested if statement together. I have the following column below. It needs to look at the column if the range is between 500-1000 it should give recommendation a (i.e. write the recommendation in another column) if it is more than 1000 it should give another recommendation in the responding column.
Income Recommendation
550 a
1200 b
750 a
1400 b
600 a
Dim i As Integer
Dim j As Integer
For i = 2 To Range(i, 1).End(xlDown).Row
If Cells(i, 1).Value > 1000 Then
Cells(i, 10).Value = "b"
i = i + 1
Else
If Cells(i, 1).Value < 1000 Then
If Cells(i, 1).Valie > 500 Then
Cells(i, 10).Value = "a"
End If
End If
i = i + 1
End If
Next i
End Sub
Several errors:
Don't rely on i having a value while it is setting the start and end values of the For loop - there is a good chance that it is 0 while calculating Range(i, 1). (Edit: Tested and confirmed that it is still 0 at the point when the end value is being calculated.) Using Range(0, 1) will give a 1004 error.
Don't increment the loop counter within the loop (i.e. don't do i = i + 1) - it will almost certainly confuse things. If you really only want to process every second row, use Step 2 on the For statement.
.Valie should be .Value
Don't use Integer data types for rows - these days Excel can handle 1048576 rows, which is more than an Integer can cope with.
Range(1, 1) is invalid syntax. When passing two parameters to the Range property, they need to be cell references. Passing a row and column is what is used when using the Cells property. (So Range(1, 1) will need to be Cells(1, 1), or Range("A1").)
Refactoring your code would give:
Dim i As Long
For i = 2 To Cells(1, "A").End(xlDown).Row
If Cells(i, "A").Value > 1000 Then
Cells(i, "J").Value = "b"
ElseIf Cells(i, "A").Value > 500 Then
Cells(i, "J").Value = "a"
Else
Cells(i, "J").Value = ""
End If
Next i
End Sub
You can do it like this with Select Case:
Public Sub TestMe()
Dim i As Long
Dim j As Long
With ActiveSheet
For i = 2 To .Cells(1, 1).End(xlDown).Row
Select Case True
Case .Cells(i, 1) > 1000
.Cells(i, 10) = "b"
Case .Cells(i, 1) < 1000 And .Cells(i, 1) > 500
.Cells(i, 10).value = "a"
End Select
Next i
End With
End Sub
It is more visible and a bit more understandable. Also, make sure that you refer to the Worksheet (in this case with ActiveSheet), to avoid reference problems in the future.
I am new with VBA for Excel as I work on a project that involves lots of calculations, which I want to automate with VBA. My data ranges from 15 months. To do this, I use loops and formulas but the code results into diferent results. Spefically:
1 - I would like to calculate the sum of values for next month and show the result in the last day of previous month. This is done in column H11.
2- I would like to use this formula =H11-G11-F11 in the last day of the month, after having determined the value of H11.
3- I want to calculate the values of next month following the same logic expect that, in this case my formula depends on the results from previous months. For instance: G29=L11+L112*K31; I know the value in K31.
Here is the code I am using:
Dim i As Long
Dim lrow As Long
Dim start_dif As Double
lrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 26 To lrow
data = Cells(i, "A")
next_date = Cells(i + 1, "A")
If Month(next_date) = Month(data) + 1 Or _
Year(next_date) = Year(data) + 1 Then
'first diference
start_dif = Cells(i, "I").Value
'Calculating value in G for each end of month
Cells(i, "G").Value = start_dif + start_dif * Cells(i, "K").Value
'setting up next start_dif
start_dif = Cells(i + 1, "I").Value
End If
Next i
Please note that I could not figured out the code for calculating the sum. Let me say how grateful I am for your help.
First, thanks for reading and any help offered.
I'm basically clueless here. I've spent the last several days trying to figure out how to code what I'd like done, and I'll try to explain it clearly.
My workbook has multiple sheets, but only two of them are of interest regarding this: Schedule & Shift.
On Schedule, there are 17 columns and 40-100 rows containing the employees name (column A) in one column, their initials (B), their employee number (C), their shift (D) and shift hours (E - which is returned via vlookup to another sheet).
Basically, I want a button that will copy the data from each of those 5 columns to the Shift sheet starting at "A3" and continue to copy down the rows in Schedule until it reaches a blank field for their name (which is column A).
So far, I've managed to copy the first row and the second row with the following code:
Private Sub CommandButton1_Click()
Dim i As Integer, IntName As String, IntInit As String, IntID As Integer, Shift As String, Hours As Integer
Worksheets("Schedule").Select
i = 1
IntName = Range("a4")
IntInit = Range("b4")
IntID = Range("C4")
Shift = Range("D4")
Hours = Range("E4")
Do While i < 5
Worksheets("Shift").Select
Worksheets("Shift").Range("a2").Select
If Worksheets("Shift").Range("a2").Offset(1, 0) <> "" Then
Worksheets("Shift").Range("a2").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = IntName
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = IntInit
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = IntID
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Shift
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hours
Worksheets("Schedule").Select
IntName = Worksheets("Schedule").Range("a4").Offset(1, 0)
IntInit = Worksheets("Schedule").Range("b4").Offset(1, 0)
IntID = Worksheets("Schedule").Range("c4").Offset(1, 0)
Shift = Worksheets("Schedule").Range("d4").Offset(1, 0)
Hours = Worksheets("Schedule").Range("e4").Offset(1, 0)
i = i + 1
Loop
End Sub
Obviously, this is clunky, and it doesn't actually do what I want beyond the 2nd time through the loop.
Any suggestions or pointers to help me move in the right direction?
Thanks again.
You're on the right path, you just need to nest our loop in another loop. Also, heed #BruceWayne's advice.
Private Sub CommandButton1_Click()
Dim i As Integer
Dim intCounter As Integer
Dim IntName As String
Dim IntInit As String
Dim IntID As Integer
Dim Shift As String
Dim Hours As Integer
'Adjust intCounter if you want to start on a row other than 1
intCounter = 1
Do
With Worksheets("Schedule")
IntName = .Cells(intCounter, 1).Value
IntInit = .Cells(intCounter, 2).Value
IntID = .Cells(intCounter, 3).Value
Shift = .Cells(intCounter, 4).Value
Hours = .Cells(intCounter, 5).Value
End With
If IntName = "" Then Exit Do
i = 1
Do While i < 5
'No need to use offset when you can just reference the cell directly.
'Also, not sure why you select this column anyhow.
'These lines can probably be deleted?
'If Worksheets("Shift").Range("a3").Value <> "" Then
' Worksheets("Shift").Range("a2").End(xlDown).Select
'End If
'Avoid using things like Select, ActiveCell, and ActiveSheet.
'What if someone clicks on something while your code is running?? Oops!
With Worksheets("Shift")
.Cells(i + 1, 2).Value = IntName
.Cells(i + 1, 3).Value = IntInit
.Cells(i + 1, 4).Value = IntID
.Cells(i + 1, 5).Value = Shift
.Cells(i + 1, 6).Value = Hours
End With
i = i + 1
Loop
'Increment to go to the next row of Schedule
intCounter = intCounter + 1
Loop
End Sub
brought in by Tim's concern about compact code, try this
Private Sub CommandButton1_Click()
With Worksheets("Schedule").Range("A4:E4").CurrentRegion
.Offset(1).Resize(.Rows.Count - 1).Copy Destination:=Worksheets("Shift").Range("A3")
End With
End Sub
I'm very new to VBA. Loops always give me trouble. I just can't seem to wrap my head around them (so, if anyone knows a good source to learn loops, I'm all ears). Anyway, I've constructed the code below from a past project that I worked with a developer on. I tried to reverse-engineer as much as possible from what he taught me - but truthfully, some of this I don't understand. I simply want to get all records in sheet "Project Analysis" that match the project number in sheet "Breakdown" range C2 that and match these criteria if range F is greater than range E, and if the difference between the two is greater than 1.5, then take the associate name (D), assigned FTE (E) and Billed FTE (F) from "Project Analysis" and populate them to "Breakdown" on starting with range 32 (there's a pivot table in between).
The compile error occurs at "Dim StudyFound as integer" just prior to the start of the second loop.
Here is the code:
Option Explicit
Sub EmployeeBill()
Dim i As Long
Dim j As Long
Dim RecFound As Long
Dim LastRec As Long
Dim CollVar() As String 'Collect Labor/Bill data from Project Analysis
Dim StaffStudyInfo() As String 'Collect unique project number data
Dim StudyRec() As String 'Collect Unique Project name per Project Number
Dim StudyFound As Integer 'Collect number of valid records
Dim UniqueInfoFound As Long 'Collect number of valid records
'Collect Project ID, Associate, Assigned FTE, and Billed FTE records from Project Analysis tab
ReDim CollVar(LastRec, 4) 'Array to collect 4 data elements
LastRec = ActiveCell.SpecialCells(xlLastCell).Row - 1
Sheets("Project Analysis").Select
RecFound = 0
For i = 1 To LastRec
If ActiveCell.Offset(i, 3).Value = Sheets("Breakdown").Range("C2").Value Then
RecFound = RecFound + 1
CollVar(RecFound, 1) = ActiveCell.Offset(i, 3).Value 'Collect Project ID
CollVar(RecFound, 2) = ActiveCell.Offset(i, 4).Value 'Collect Associate
CollVar(RecFound, 3) = ActiveCell.Offset(i, 5).Value 'Collect Assigned FTE
CollVar(RecFound, 4) = ActiveCell.Offset(i, 6).Value 'Collect Billed FTE
End If
Next i
'Collect Associates who billed 1.5 times their FTE Assigned value
ReDim StaffStudyInfo(4, RecFound)
**Dim StudyFound As Integer**
UniqueInfoFound = 0
For i = 1 To RecFound
StudyFound = 0
For j = 1 To UniqueInfoFound
If StaffStudyInfo(1, j) = CollVar(i, 1) Then
If CollVar(i, 6).Value > CollVar(i, 5) Then
If CollVar(i, 6) - CollVar(i, 5) > 1.5 Then
StudyFound = 1
Exit For
End If
End If
End If
Next j
If StudyFound = 0 Then
UniqueInfoFound = UniqueInfoFound + 1
StaffStudyInfo(1, UniqueInfoFound) = CollVar(i, 4) 'Associate
StaffStudyInfo(2, UniqueInfoFound) = CollVar(i, 5) 'Assigned FTE
StaffStudyInfo(3, UniqueInfoFound) = CollVar(i, 6) 'Billed FTE
End If
Next i
'Populate all that meet above criteria onto "Breakdown" sheet
Sheets("Breakdown").Select
For i = 1 To UniqueInfoFound
Range("C" & i + 4) = StaffStudyInfo(1, i) 'Populate Associate
Range("D" & i + 4) = StaffStudyInfo(2, i) 'Populate Assigned FTE
Range("E" & i + 4) = StaffStudyInfo(3, i) 'Populate Billed FTE
Next i
Range("A1").Select
End sub
Any help would be greatly appreciated. Thank you!
You've already defined StudyFound near the top:
...
Dim StudyRec() As String 'Collect Unique Project name per Project Number
Dim StudyFound As Integer 'Collect number of valid records
Dim UniqueInfoFound As Long 'Collect number of valid records
...
Remove one of the definitions and it should be fine.