Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
I have an Excel Workbook with 4 sheets in my hand. Each sheet contains daily data for a stock. Each sheet contains 3 columns: the first column lists "Date": 1/6/04 - 6/20/14. The 2nd column is the daily return of this stock recorded on each day. The 3rd column is the daily volume of this stock.
I want to compile the data in the four sheets to just one sheet with 9 columns: 1st column is the date. 2nd&3rd columns contain the return & volume of the 1st stock; 4th&5th columns have the return & volume of the 2nd stock; 6th&7th for the 3rd stock and 8th & 9th for the last stock. In other words, the data of the four stocks would be listed on the same sheet by "Date".
One problem: the first stock has 2692 trading days recorded, yet the 2nd has only 2638 trading days. The 3rd and 4th stocks both have 2633 days recorded. And, for example, on 5/13/2009, only the 1st and the 4th stocks were traded (with data available), but the 2nd and 3rd stocks do not have data, so 5/13/2009 is not included in the 2nd and 3rd sheet of the raw data file. But I want this date to be included in my final (compiled) data sheet because on this day, at least one stock is available.
Eventually, I wish my final sheet to have all the dates when any stocks were traded. For all the missing data (or missing spots), I wish the cells to be filled with NaN.
How can I achieve this in excel VBA/Macro? I also use R so any coding advice with R on this problem would also help.
Thanks.
This is just an outline (I hope the SO police don't shoot me).
Can you get started with this?
Sub Main()
do ' this is the outer loop
for sheet = 1 to 4
get the lowest unselected date
next sheet
if all sheets are done, then exit sub
for sheet = 1 to 4
get either data or NaN for the selected date
next sheet
loop
End Sub
EDIT: ' (I don't know what "on hold" does) This should be a good model for using arrays. (I'll do anything for 15 points.) I've made many assumptions. You don't need to change dates into integers to compare.
Option Explicit
Sub Demo()
Dim iSheet&, aSheets(2) As Worksheet, Outsheet As Worksheet
Dim iRow&(2), iLastRow&(2), outRow&, iCol1&, iCol2&, Date1$, selectedDate$
Set aSheets(1) = ThisWorkbook.Sheets("adam")
Set aSheets(2) = ThisWorkbook.Sheets("bill")
Set Outsheet = ThisWorkbook.Sheets("zack")
iLastRow(1) = 3: iLastRow(2) = 4 ' ending rows
iRow(1) = 1: iRow(2) = 1 ' starting rows
outRow = 1
Do ' this is the outer loop
selectedDate = "12/31/9999" ' starting date (high)
For iSheet = 1 To 2
If iRow(iSheet) <= iLastRow(iSheet) Then
Date1 = aSheets(iSheet).Cells(iRow(iSheet), 1)
If Date1 < selectedDate Then selectedDate = Date1
End If
Next iSheet
If selectedDate = "12/31/9999" Then Exit Sub ' no more
Outsheet.cells(outRow, 1) = selectedDate
For iSheet = 1 To 2
iCol1 = iSheet * 2 ' output columns
iCol2 = iCol1 + 1
If iRow(iSheet) <= iLastRow(iSheet) Then
Date1 = aSheets(iSheet).Cells(iRow(iSheet), 1)
If Date1 = selectedDate Then
Outsheet.Cells(outRow, iCol1) = aSheets(iSheet).Cells(iRow(iSheet), 2)
Outsheet.Cells(outRow, iCol2) = aSheets(iSheet).Cells(iRow(iSheet), 3)
iRow(iSheet) = iRow(iSheet) + 1 ' next row
Else
Outsheet.Cells(outRow, iCol1) = "na"
Outsheet.Cells(outRow, iCol2) = "na"
End If
End If
Next iSheet
outRow = outRow + 1
Loop
End Sub
Related
Background: I'm relatively new to VBA, but I see the value in becoming more comfortable using the skillset.
Goal: Move unorganized data (srce) from one spreadsheet into a different more structured spreadsheet (dest) that can later be uploaded into a software application. I have ~500 of these spreadsheets that need to be migrated, so there is an immense amount of time that could be saved by automating this.
Data: The data is a history of truck maintenance. Periodic maintenance takes place throughout the year with multiple services often performed during a single maintenance routine. Under each routine maintenance, there is a date, # of hours on the vehicle when maintenance is performed, and the type of service performed (consistently column "A").
Data Structure: All service types are contained in column A. Starting in column C & D, I have all of the dates the services performed in 2021 from C11:C34. The # of hours the vehicle has operated at the time of maintenance are contained in cells D11:D34. Subsequently, the dates and # of hours for each maintenance in 2022 are contained in columns E and F.
Challenge: While moving down the rows and before switching to the next column, I need to:
Check for repeat dates
Copy the type of services performed at that date
Paste all of those services performed under a single line item in my destination spreadsheet starting in column T and ending in Column Y (In case ~8 services are performed under a single maintenance routine.)
Question:
How can I complete the above challenge without duplicating entries and keep all services performed on the same date within a single line in my dest spreadsheet?
Below is my code thus far (I've left a comment in the section that is where I intended to craft an answer to my dilemma):
Sub VehicleDataExport()
Application.ScreenUpdating = False
'Set reference cell for output called "dest"
Set dest = Sheets("Dest").Range("A2")
'Initialize counter for destination for how many rows down we are so far
dindx = 0
'Set reference cell for source data called "srce"
Set srce = Sheets("Srce").Range("C11")
'Set reference cell for source for how many columns over we are
cindx = 0
'Set the service type index
Set serviceindex = Sheets("Srce").Range("A11")
'Collect name, vin, and in-service date
vehicle_name = Sheets("Srce").Range("A1")
vehicle_vin = Sheets("Srce").Range("B7")
started_at = Sheets("Srce").Range("B8")
'Go over from anchor column while not empty
While srce.Offset(-1, cindx) <> ""
'set row index so that it can restart everytime you switch columns
rindx = 0
'Cycle down through rows until an "DATE" is found
While srce.Offset(rindx, cindx) <> "DATE"
'Set counter for duplicate index so the program will move through the data while looking for duplicate DATES
duplicateindx = 0
'If statement to determine if something is in the cell - 2nd header row
If srce.Offset(rindx, cindx) > 0 Then
'True Case: copy the date, hours, and service type
service_date = srce.Offset(rindx, cindx)
service_hours = srce.Offset(rindx, cindx + 1)
service_type = serviceindex.Offset(rindx, 0)
meter_void = ""
'Properly label and account for Dot Inspection
If service_type = "DOT Inspection" Then
service_hours = 0
meter_void = True
'secondary_meter_value needs to be 0
'secondary_meter_void needs true
End If
'CHECK FOR DUPLICATE DATES AND COPY THEM TO A SINGLE ROW IN THE DESTINATION
'Paste all of the numbers into a destination row
dest.Offset(dindx, 0) = vehicle_name
dest.Offset(dindx, 1) = vehicle_vin
dest.Offset(dindx, 2) = started_at
'Variable inputs
dest.Offset(dindx, 3) = service_date
dest.Offset(dindx, 13) = service_hours
dest.Offset(dindx, 17) = service_type
dest.Offset(dindx, 14) = meter_void
'Add to both the row and destination indexes
rindx = rindx + 1
dindx = dindx + 1
'If no inspection is found, move down one row
Else: rindx = rindx + 1
'End if statement
End If
'end column specific while loop
Wend
'add two to the column index - account for both the date and hours column
cindx = cindx + 2
'End the initial while loop
Wend
Application.ScreenUpdating = True
End Sub
This really sounds like a job for PowerQuery but if I was to tackle it with VBA I'd use a Scripting.Dictionary. I would also write a small data class that includes all of your service types as Boolean.
I don't fully understand your data structure but some pseudo code might look like this:
Const SRVCECOL As Long = 1
Const HOURSCOL As Long = 2
Function ExtractTransformServiceData(src As Workbook) As Object
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim svcDates As Range
Set svcDates = src.Sheets(1).Range("C11:C34")
Dim svcDate As Range
For Each svcDate in svcDates
Dim tsd As TruckServiceData
If dict.Exists(svcDate.Value) Then
Set tsd = dict.Item(svcDate.Value)
Else
Set tsd = New TruckServiceData
dict.Add svcDate.Value, tsd
End If
tsd.SetHoursForService( _
svcDate.Offset(0, SRVCECOL).Value, _
svcDate.Offset(0, HOURSCOL).Value)
Next svcDate
Set ExtractTransformServiceData = dict
End Sub
I have a for loop that iterates through each sheet in my workbook. Each sheet is identical for most purposes. I am making an overview sheet in my workbook to express the results from the data in the other sheets(the ones that are identical).
There are 11 vehicles, each with their own sheet that has data from a test from each day. On any given day there can be no tests, or all the way to 30,000 tests. The header of each column in row 47 states the date in a "06/01/2021 ... 06/30/2021" format. The data from each iteration of the test will be pasted in the column of the correct date starting at row 49.
So what my overview page needs to display is the data from the previous day. In one cell on my overview there is a formula for obtaining just the number of the day of the month like 20 or 1 etc. Using this number, the number of the day is the same as the column index that the previous day's data will be in conveniently. So in my for loop I want to have a table that has the name of each sheet in column B, in column C I want to display the total number of tests done in that day(not the sum of all the data), in column D I need the number of tests with a result of 0, in column E I need the number of tests that have a result above the upper tolerance, and in column F I need the number of tests that have a result below the lower tolerance minus the result in column D.
I've been playing with the Application.WorksheetFunction.Count and CountIf functions but I keep getting 0 for every single cell. I made two arrays for the upper and lower tolerance values which are type Longs called UTol and LTol respectively. TabList is a public array that has each of the sheet names for the vehicles stored as strings. finddate is an integer that reads in Today's day number which is yesterday's column index. I've included a picture of the table in question and my for loop code:
finddate = Worksheets("Overview").Range("A18").Value
For TabNRow = 1 To 11
startcol = 3
Worksheets(TabList(TabNRow)).Activate
Debug.Print (TabList(TabNRow))
'Total number of tests done that day
Worksheets("Overview").Cells(startrow, startcol).Value = Application.WorksheetFunction.Count(Range(Cells(49, finddate), Cells(30000, finddate)))
startcol = 4
'Total number of 0 results, this used to get the number of 0's from each sheet but that row has since been deleted
Worksheets("Overview").Cells(startrow, startcol).Value = Worksheets(TabList(TabNRow)).Cells(48, finddate).Value
startcol = 5
'Total number of results above tolerance
Worksheets("Overview").Cells(startrow, startcol).Value = Application.WorksheetFunction.CountIf(Range(Cells(49, finddate), Cells(30000, finddate)), ">" & UTol(TabNRow))
startcol = 6
'Total number of results below tolerance
Worksheets("Overview").Cells(startrow, startcol).Value = Application.WorksheetFunction.CountIf(Range(Cells(49, finddate), Cells(30000, finddate)), "<" & LTol(TabNRow))
startrow = startrow + 1
Next TabNRow
```
No need to select/activate sheets when referencing them. See: How to avoid using Select in Excel VBA
Something like this should work:
Dim wsOv As Worksheet, wsData As Worksheet, rngData As Range
Set wsOv = ThisWorkbook.Worksheets("Overview")
finddate = wsOv.Range("A18").Value
For TabNRow = 1 To 11
Set wsData = ThisWorkbook.Worksheets(TabList(TabNRow))
Set rngData = wsData.Range(wsData.Cells(49, finddate), _
wsData.Cells(Rows.Count, finddate).End(xlUp))
Debug.Print wsData.Name, rngData.Address 'edited
With wsOv.Rows(2 + TabNRow)
.Columns("C").Value = Application.Count(rngData)
.Columns("D").Value = Application.CountIf(rngData, 0)
.Columns("E").Value = Application.CountIf(rngData, ">" & UTol(TabNRow))
.Columns("F").Value = Application.CountIf(rngData, "<" & LTol(TabNRow)) _
- .Columns("D").Value
End With
Next TabNRow
Every month I update my new aged balance, and then I create automatically a new sheet with a macro, which will filter customer.
So here are my current sheets:
Each month, I'm following my customers's payments by adding comments at Column 10.
On the latest page, I want to add old comments after the column 10 so at column 11,12,13 there will be old comments... So there will be as many new columns as there are sheets of customers.
Old comments are in sheets "clients 2019-01-31" and "clients 2019-02-28"
I want to add them in "clients 2019-03-30"
For doing that, i think using Vlookup was the best plan. But looks like I have too many variable, it doesn't work:
Error 1004.
I really tried much things, like declaring sheets before each cells, activating the sheet just before.
Worksheets(Sheets.Count).Activate
I can't get it working. If something isn't clear, please tell me I'll try to explain it better.
Sub Macro1()
Dim nbCustomer ' Customer Number, this value is not fix in my whole program
nbCustomer = 244
Dim numCol ' Column Number
numCol = 11
Dim nbws ' Sheets number
nbws = Sheets.Count
nbws = nbws - 1 ' Because we don't need to lookup on the last page
While (nbws > 1)
Dim numL ' Line Number
numL = 2
While (numL <= nbCustomer)
nbCustomer = nbCustomer + 10
Worksheets(Sheets.Count).Cells(numL, numCol) = Application.VLookup(Cells(numL, 1), Sheets(nbws).Range(Cells(1, 1), Cells(nbCustomer, 10)), 10, False)
numL = numL + 1
nbCustomer = nbCustomer - 10
Wend
numCol = numCol + 1
nbws = nbws - 1 ' we will look up our data on the previous sheet
Wend
End Sub
Im currently creating a template for our report. And I would like to do some automation.
I have a source sheet which I call "KPISource" (Data source is in sharepoint, thus this is a table). And in the first column I would like to get data which has has the current Month and the previous month.
Basically, If it is current month, it will then put the data in the "August" column. And If the date is previous month, then it will also put the data in the "July".
In my source sheet, the columns are Date, Tickets Solved (productivity), YTD, Ticket Reopen Rate(quality), Aging <5 days (Quality), YTD (Aging <5 days) Aging > 5 days (Quality), YTD (Aging >5 days), Customer Satisfaction, YTD (Customer Satisfaction)
Currently here is my code, but no output is appearing. This is the code that I'm trying if the there is a previous date in column 1 (KPISource), then it will have the value in KPI.Cells(6, 4).Value (Tickets Solved "July").
Sub OperationalKPI()
Dim KPI As Worksheet
Set KPI = Sheets("OperationalKPI")
Dim KPISource As Worksheet
Set KPISource = Sheets("KPISource")
mPrevious = Format(DateAdd("m", -1, Date), "mmmm")
mCurrent = Format(Date, "mmmm")
lastrow = KPISource.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow
If mPrevious = KPISource.Cells(x, 1) Then
KPI.Cells(6, 4).Value = KPISource.Cells(x, 2).Value
End If
Next x
End Sub
The problem, based upon your feedback, is in the line
If mPrevious = KPISource.Cells(x, 1) Then
mPrevious is a string containing the name of the month, eg "July", however KPISource.Cells(x, 1) contains a date so the two are never going to be equal.
Change the line to:
If mPrevious = Format(KPISource.Cells(x, 1),"mmmm") Then
This will make both items strings with the name of the month in them and the If should find the matches.
Sorry if this isn't explained overly well, im a macro newbie so im not sure if this one is even possible..
I'm looking to create a weekday table for some simple statistic reporting that automatically creates a new row each day, and removes the oldest, showing the data for the current day and 6 days previous. Ideally i'd like the current day at the top of the table, and each day the entered data in the corresponding row moves down 1 row creating space for the new day's stats.
As some background info on what im trying to do.. im basically creating a friendly UI display (offline HTML) of the data recorded in a very simple 5 column (stats) by 7 row (weekdays) table. This database will need to be updated by multiple people with limited technical ability, so im basically trying to make it as easy as possible for them to enter stats each day without having to worry about also updating to correct dates and making sure they are replacing the right days data etc. In theory, it would be great to automate the process of updating the table each day to create space for them to enter the current days data, pushing yesterdays data down one row (and if the cell ranges for the whole table always the same, it should allow me to automate the updates to the offline HTML display as well).
Any ideas?
This should get you started:
Sub WeekdayTable()
Dim tbl As Range
Dim r As Integer
Set tbl = Range("A1:E7") 'Define your table, 5 columns x 7 rows. Modify as needed.
For r = tbl.Rows.Count To 2 Step -1
tbl.Rows(r).Value = tbl.Rows(r - 1).Value
Next
'empty out row 1
tbl.Rows(1).Clear
'Assuming the column 1 contains valid DATE values, _
' we can use the DateAdd function to print the next date:
tbl.Cells(1, 1) = DateAdd("d", 1, tbl.Cells(2, 1))
End Sub
First give a name to the date header cell. (Click the cell. Look at the top left of the screen where the cell coordinates appear. "A1", "B2", etc...
In that textbox, type the header name: "MyDateHeader"
then, use this macro (you can add it to the workbook open event, or activate)
Sub YourMacro()
Dim DateHeader As Range
Set DateHeader = Range("MyDateHeader")
Dim FirstDateCell As Range
Set FirstDateCell = DateHeader.Offset(1, 0)
Dim MyDay As Integer, MyMonth As Integer, MyYear As Integer
Dim CurrDay As Integer, CurrMonth As Integer, CurrYear As Integer
MyDay = Day(FirstDateCell.Value)
MyMonth = Month(FirstDateCell.Value)
MyYear = Year(FirstDateCell.Value)
CurrDay = Day(Date)
CurrMonth = Month(Date)
CurrYear = Year(Date)
If (MyDay <> CurrDay) Or (MyMonth <> CurrMonth) Or (MyYear <> CurrYear) Then
FirstDateCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
DateHeader.Offset(1, 0).Value = Date 'Careful, FirstDateCell has moved down.
DateHeader.Offset(8, 0).EntireRow.Clear
End If
End Sub