Right now, my code keeps coming up with an error when I try to run it or test it with an "Invalid use of Property" message. When I run it, the program highlights the line "Sub Update_Audit()"
In my code, I'm trying to manipulate data for an audit between 3 sheets in a workbook.The first block of my code is to paste the data of items I need to find for the audit from the original sheet onto the 3rd sheet by setting each row equal to the data of the original row in the first sheet. The second block is used to re-paste the data of found objects in the Audit to only have values rather then formulas.Then the code will iterate through the Audit list to check for the same values and delete those values on the list in the 3rd sheet. The 2nd sheet will have the list of found audit items being pasted in at the same time. The end result is 3 sheets, 1st being just the main list where all the data is collected, the 2nd being a list of found audit items, and the 3rd being left over items that need to be found at a later date.
Sub Update_Audit()
Dim j As Integer
Dim i As Integer
Dim k As Integer
Dim Aud_Tot As Integer
i = 2
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
k = 2
Do While Cells(k, 24) <> ""
Tab_Data = Range(Cells(k, 24), Cells(k, 44)).Value
Worksheets(3).Activate
Range(Cells(k, 1), Cells(k, 22)).Value = Tab_Data
Worksheets(1).Activate
k = k + 1
Loop
Do While Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value)
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(2).Activate
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(1).Activate
For j = 2 To Aud_Tot
If CStr(Cells(j, 24).Value) = CStr(Cells(i, 2).Value) Then
Worksheets(3).Activate
Range(Cells(j, 1), (Cells(j, 22))).Delete Shift:=xlShiftUp
Worksheets(1).Activate
Exit For
End If
Next j
i = i + 1
Loop
End Sub
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 have a sheet full of data, from to the column A to column G.
How can a VBA Macro:
copy rows (not the entire row, only the column A,B,C,D,E) if the value in C<>"CLOSE" and the value in B is <19:00 And >00:00.
Edit:
I tried this solution, but when I run it, I don't find any selected cells.
Dim r As Range, N As Long
Set r = Intersect(ActiveSheet.UsedRange, Range("B:C"))
N = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To N
cc = Cells(i, 2).Value
dd = Cells(i, 3).Value
If cc >= "19:00" And cc < "00:00" And dd <> "Close" Then
ActiveSheet.Range(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4), Cells(i, 5)).Select
End If
Next i
I've already tried to use the letters instead of the numbers to indicate the columns (...Cells(i,A) instead of Cells(i,1)) but it doesn't work.
Thanks.
Try this code:
Sub CopyRows()
Dim lastRow As Long, i As Long, time As Variant
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To lastRow
If Cells(i, 3) = "CLOSE" Then GoTo SkipLoop
'extract just hour and see if it's less than 19
If CInt(Left(Cells(i, 2), 2)) < 19 Then GoTo SkipLoop
Range(Cells(i, 1), Cells(i, 5)).Select
SkipLoop:
Next
End Sub
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.
What I'm trying to do is have the program go through is find a certain value from within a column of cells and see if it matches with one cell after I special paste the value, and if there is a match delete the associated cell and its row of cells. What is happening is that the special pasting part of the program is working, but the associated cells are not being deleted. To clarify, I'm trying to delete a whole row from a certain column based on whether there's a match
Dim j As Integer
Dim i As Integer
i = 2
Dim Aud_Tot As Integer
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial xlPasteValues
For j = 2 To Aud_Tot
If Cells(j, 24).Value = Cells(i, 2).Value Then
Range(Cells(j, 24), (Cells(j, 42))).ClearContents
End If
Next j
i = i + 1
Else
Exit Do
End If
Loop
It seems you want to delete the row but you are only using ClearContents. To delete you can change that line to Range(Cells(j, 24), (Cells(j, 42))).Delete Shift:=xlShiftUp, you can also use xlShiftToLeft.
Did you want to delete the entire row or just the range you have?
i have been having problems with getting my code to run through its conditional loop and stopping. Here is what I have:
Do While True
Dim i As Integer
i = 2
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial
i = i + 1
Else
Exit Do
End If
Loop
What I'm trying to do is to get the program to check if one cells isn't empty and if another doesn't have an error in it, if that condition is met, then the program would copy a certain row and re-paste it as just it's values since some of the cells in the row is a formula. For some reason the loop doesn't exit and Excel crashes, am I missing something?
the i = 2 should be outside
Dim i As Integer
i = 2
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial
i = i + 1
Else
Exit Do
End If
Loop
Two points :
The i = 2 must be outside the while loop.
Don't use Copy and PasteSpecial. Using the clipboard will give lots of problems later on. Additionally PasteSpecial likes you to be specific with "what" PasteSpecial action you're using. Rather assign values directly.
Dim i As Integer, Dataset As Variant
i = 2
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
'This seems silly, but it overwrites the cell with its value.
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
i = i + 1
Else
Exit Do
End If
Loop