How can I use VBA to load contents into a cell comment? - excel

I have a spreadsheet that I will update monthly that tracks the percentage of applications approved.
I want to be able to hover over a cell and see, in a comment, data relevent to the contents of that cell. For example:
This is a snip of my Trend tab.
There is 2016Data tab where 123 is the count of applications received in the month of January 2016 and 102 is the count of applications that were approved. The 2016Data tab is static and does not change as it is historic reference to compare this year against last.
There is a 2017Data tab that has the same information but this information will be refreshed monthly.
NOTE: All application records on the data tabs are notated in column A:A with a 1 so I can sum the columns where other attributes exist to help me analyze data. As well each application is notated with a 1 or 0 in column B:B so I can sum that column to know the number of applications approved. Here is a sample of information on those data tabs:
I manually created the snip above to show what I'm trying to re-create in VBA and each time I refresh 2017Data I need all the counts to be updated in all of the comments automatically.
Also worth noting - I am a VBA toddler, and my experience with it is very limited.

Below is how you can create a comment to a cell.
Dim mySheet, myCell
Set mySheet = ThisWorkbook.Sheets("Sheet1")
Set myCell = mySheet.Cells(1, 1)
On Error Resume Next 'In case there is an existing comment to the cell already, you will get an error
myCell.AddComment
myCell.Comment.Visible = False
myCell.Comment.Text Text:="myComment text"
You will have to write to own logic to read the content from your source sheet and add as a comment on your destination.
'Read from a cell
Dim strCellVal
strCellVal = myCell.Value
'Write to a cell
myCell.Value = "My Cell Content"
--EDIT--
Try below to loop each cells,
Dim UsedRange, CurrentCell
' Assuming your data starts from cell A1
UsedRange = "$A$1:" + mySheet.Cells.SpecialCells(xlCellTypeLastCell).Address
For Each CurrentCell In mySheet.Range(UsedRange).Cells
MsgBox CurrentCell
Next

Related

How to lookup today's date and edit the cell next to it

I need to lookup a specific cell in another worksheet that has today's date as value, and edit the value of its adjacent cell by +1.
I am attempting to create a 'Points Tracker' for my studies. I will award myself one point for every task I complete. I have a workbook with two worksheets ('Sheet1' and 'data').
On the 'Sheet1' worksheet, I will have a visual look of my progress with a dynamic heatmap ranging from the past 27 weeks. Also a button at the top, which I intend to press every time I finish a task to add one point to my daily tally.
On the 'data' worksheet, I have a simple table with two columns (columnA will be the date ranging from 2022 to 2026 & columnB the points for each day.
I linked the values in the columnB of the data's table to the dynamic heatmap in Sheet1, which means, when the points in columnB are edited, I will see them live in the heatmap.
Now, I need to add points to today's date in the data's table. Like what Vlookup does, but instead of returning the value in the range's column2, I want to edit it by 1.
This appears to be very similar to what I want.
I tried the following, which results in an error:
Private Sub Worksheet_Change()
Dim temp As Range
If Not Intersect(Target, Range("E3")) Is Nothing Then
Set temp = Range("data!A:A").Find(Trim(Range("E3")), LookIn:=xlValues, lookat:=xlWhole)
If Not temp Is Nothing Then
Range("K3") = temp.Offset(0, 1)
temp.Offset(0, 2) = Range("Q3")
End If
End If
End Sub
Something else that I tried was to assign a specific cell in Sheet1 for today's points (Sheet1!$A$1), and then adding the following formula to the cells in columnB of the data table: =If(A1=TODAY(),Sheet1!$A$1,B1).
This way, if I were to add a simple +1 button to that (Sheet1!$A$1), the data table would populate accordingly. However, there's a circular reference in that formula that messes up my heatmap.
Personally, I would cut out the Intersect function as it's not really applicable and additionally change the event to Button1_Click since you only want it to run when the button is clicked anyways.
Sub Button1_Click()
Dim temp As Range
Set temp = Range("data!A:A").Find(What:=Format(Date, "d/m/yyyy"), LookIn:=xlValues, LookAt:=xlPart)
If Not temp Is Nothing Then
temp.Offset(0, 1).Value2 = temp.Offset(0, 1).Value2 + 1
End If
End Sub
You would also ideally put this in your workbook's ThisWorkbook project.

Moving Data to new tab and reformatting it to make it easier to Export To Access

We currently have a spreadsheet that is used for scheduling, the gentleman using it doesn't want it changed so what I was thinking was create a new sheet with different formatting using VBA or a macro or?? I will then be able to import the new sheet into access where it is needed for a different program. I am attaching 2 different pictures the first is what it looks like now and 2nd is what I would like it to look like.
Old format
Better picture of Old Format
New format
. I have not done a lot of coding in Excel, normally just ='Sheet1'!E5, but didn't see how I could move the date properly and then not have the date show up any where else. The schedule may have 1 item assigned for a day or multiple items. If I have left something out that would be helpful please let me know.
If I understand you correctly...
The old format is something like this :
The expected result for the new format :
If that's what you mean...
Sub test()
Dim rg As Range: Dim cell As Range
Dim rgCnt As Range: Dim cnt As Long
Sheets("Sheet1").Copy Before:=Sheets(1)
With ActiveSheet
.Name = "TEST"
.Columns(1).Insert
.Range("A1").Value = "DATE"
Set rg = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each cell In rg.SpecialCells(xlCellTypeBlanks)
Set rgCnt = Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown))
If cell.Offset(2, 0).Value = "" Then cnt = 1 Else cnt = rgCnt.Rows.Count
cell.Offset(1, -2).Resize(cnt, 1).Value = cell.Offset(0, 1).Value
Next
rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
There is a consistent pattern in the old format, where to the right of each blank cell in column B is the date. So we use the blank cell in column B as the benchmark to get the date in column C.
The process:
it copy sheet1 where the old format is.
name the copied sheet to "TEST"
insert one column, and put the header name "DATE"
since HD-2 now is in column C (after insert one column)
so the code make a rg variable to data range in column C.
Then it loop to only the blank cell in rg
set the range to check how many data under each date into rgCnt variable
if the looped cell offset(2,0) is blank then there is only one data under the date so it make the value of cnt variable = 1
if the looped cell offset(2,0) is not blank then there is more than one data under the date, then have the value of cnt from the rgCnt rows count.
then it fill column A (DATE header) with the date as many rows defined by the cnt value.
After the loop done, it delete the entire row of all blank cell in rg variable.

Excel fetch rows based on a cell value in another sheet

sorry for being a total noob in excel!
I have two sheets, sheet 1 named "Stocks" and sheet 2 named "Stocks search".
In "Stocks" I have from A1 to B700 values. In A column I have the stocks symbols and in B column I have the stocks' issuers symbols, so every entry in A column is unique, yet there can be repeating entries in column B.
So in sheet "Stocks search", if I enter in A1 an issuer's symbol, I want for the formula to go search in sheet "Stocks" and fetch all stocks that this issuer has in new rows.
How can this be done in a formula? Thanks in advance!
This is a VBA solution to the question. IMHO, this is more appropriate than a formula (in this case). The formula approach is OK, but there are drawbacks - you have to remember the CSE rule, and then copy the formulas down the right number of rows (which you don't know in advance), etc, etc.
This code uses the same assumptions as the formula approach.
1 - sheets = Stocks and Stock report
2 - Data in Sheets, columns A and B (header in row 1)
3 - lookup code is on Stock report
4 - Output is on Stock report
One of the advantages is that if new data is added to the Stocks sheet (i.e. the bottom row > 700), the vba automatically adjusts.
The code is self-documented. But the essence is that it creates an autofilter on "Stocks" using the lookup value as the criterion; copies the rows that meet the criteria; and pastes the result to an output range on "Stock reports". The output range is cleared before the copy/paste takes place so that there are no left-overs from any previous lookup.
I think there's something to be said for creating a dropdown list for the lookup cell. No doubt that could be automated too by getting the codes from Column A, getting the unique values, and then apply them to the lookup cell. Just a thought;)
Sub so_52537740()
' CREDITS
'
' Refer: https://stackoverflow.com/questions/17531128/copy-paste-calculate-visible-cells-from-one-column-of-a-filtered-table
' Date: 8 July 2013
' Submitted by: Jon Crowell (https://stackoverflow.com/users/138938/jon-crowell)
Dim src As Worksheet, tgt As Worksheet
Dim filterRange As Range, copyRange As Range
Dim lastRow As Long
Dim stocks As String, stockreport As String
' set values for sheet names
stocks = "Stocks"
stockreport = "Stock report"
' set values for Sheet variables
Set src = ThisWorkbook.Sheets(stocks)
Set tgt = ThisWorkbook.Sheets(stockreport)
' clear the exist target data
tgt.Range("A4:B" & Rows.Count).ClearContents
' turn off any autofilters that are already set
If src.AutoFilterMode Then src.AutoFilter.ShowAllData
' find the last row in the Stocks sheet with data in column A
lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
' the range that we are auto-filtering (all columns)
Set filterRange = src.Range("A1:B" & lastRow)
' the range we want to copy (only columns we want to copy)
' in this case we are copying both columns A and B
' we set the range to start in row 2 to prevent copying the header
Set copyRange = src.Range("A2:B" & lastRow)
' filter range based on column A being equal the the value in Cell A1 of the stockreport
' consider making this a dropdown list so that there are no errors
filterRange.AutoFilter field:=1, Criteria1:=Format(Sheets(stockreport).Range("a1").Value)
' copy the visible cells to our target range
' note that you can easily find the last populated row on this sheet
' if you don't want to over-write your previous results
copyRange.SpecialCells(xlCellTypeVisible).copy tgt.Range("A4")
' turn off any autofilters that are already set
If src.AutoFilterMode Then src.AutoFilter.ShowAllData
End Sub
Giving due credit: There is, as they say, nothing new under the sun. I have based this answer on an excellent piece of work by Jon Crowell on a question in StackOverflow "Copy/Paste/Calculate Visible Cells from One Column of a Filtered Table" in July 2013. Just goes to show what a bit of Googling and perseverance can achieve.
I believe I have an answer for you.
Try
=IFERROR(INDEX('Stocks Search'!$A$1:$A$700,SMALL(IF('Stocks Search'!$B$1:$B$700=$A$1,ROW('Stocks Search'!$A$1:$A$700)-MIN(ROW('Stocks Search'!$A$1:$A$700))+1),COLUMNS($A$1:A1))),"")
This is a CSE formula. What that means is once you enter it into cell B1, you will need to press Control+Shift+Enter. Once you do this, these brackets will appear around your formula {}
Click the fill button in the bottom right of the cell and drag the formula to the right (you will need to do this for as many cells as it is possible for answers). So if Company A has 40 possible answers, you will need to have this formula go at least 40 cells to the right.
The application of CSE formulas can be tricky. Essentially you need to go to the end of the formula in the formula bar, and then use Control+Shift+Enter.
I hope this helps.

Formula to pull text from one sheet in excel to another to summarize (not numbers)

I have a spreadsheet that has a tab for each research location. There is a section on the sheet that has several columns. Three of the columns are as follows: 1 lists action items (text) 1 lists who is responsible (text) and 1 lists the due date (date field). The rows in this same "table" represent categories. In many cases there is an action item only in one or two categories or maybe none at all for some.
I would like to query each tab that represents a research site and pull any action items, the responsible party and date onto another tab so that we can see all action items in one place for all the sites vs. going tab by tab to review.
I thought some sort of IF or VLOOKUP function might work, or some sort of pivot table but because it is text and not numbers I am having a hard time crafting the appropriate formula. I was also told I could do some sort of reference look up (like putting a word like ACTION at the start of any text I want to find later) but this seems more complicated than it needs to be.
Any help would be deeply appreciated.
I don't think VLOOKUP can solve your problem. You definitely need VBA so something like this will get you going. Make a new sheet called as Summary and put this code in the sheet:
Sub SummarizeSheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Summary").Activate
Range("A2").Select
For Each ws In Worksheets
If ws.Name <> "Summary" Then
If ws.Range("A2") <> "" Then 'A2 is blank means no action items found so go to next worksheet
ws.Range("A2:C100000").Copy 'Adjust your range here
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(2, 0)' Paste the copied range
End If
End If
Next ws
Application.CutCopyMode = False
End Sub
You have to adjust the code to suit your needs. Assumption here is your action items starts with cell A2 and responsible person and due date are in cell B2 and C2 respectively.

Moving Rows to another sheet in a workbook

I need Help!
I am not well versed in VBA or Macros but i cannot find any other way to accomplish what i need to do without using it.
I have a sheet which i will be using to track Purchase orders, and what i need to do is; when i have a row in sheet 1 (Purchase Orders) which has been recieved i.e. the date of receipt has been recorded in column H i need for the entire row to be cut and pasted into sheet 2 (Received orders).
The header takes up the first 7 rows the rows, so i need the macro to look at rows 8-54. Once the received items are removed from sheet 1, i need the row to also be deleted or preferably for the list to be sorted by column A moving the now empty row which has been cut from open for a future entry.
Any help would be greatly appreciated.
The "Record Macro" feature should be enough to do the task you describe.. In Excel 2007, go to the Developer tab in the Ribbon, and select "Record Macro", and perform exactly the steps you are describing. It will record the equivalent VBA code, which you can then execute - or tweak/modify.
I tested this out, here's one way to do it:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim receivedDate As Range, nextOpen As Range, isect As Range
Set receivedDate = Sheet1.Range("H8:H54")
Set isect = Application.Intersect(Target, receivedDate)
If Not (isect Is Nothing) And IsDate(Target) = True Then
Set nextOpen = Sheet2.Range("A1").End(xlDown).Offset(1, 0)
Target.EntireRow.Copy Destination:=nextOpen.EntireRow
Target.EntireRow.Delete
End If
Application.EnableEvents = True
End Sub
This would be pasted into the Sheet1 code. Any time a cell is changed on sheet1, the code checks to see if it's in the critical range that you specified. (H8:H54) If it is, it then checks to see if it's a date. If it is, it then copies the entire row, puts it in the next open row on Sheet2, and deletes the original row. The cells below it will get shifted up so there are no gaps.
Since the code functions on a cell changing event, it disables "Application.EnableEvents" in order to avoid a loop of changing a cell to call an event which changes a cell to call an event... etc.

Resources