I'm a complete novice at macros but I've had trouble finding the exact solutions I need, and more trouble combining them. I get this raw data report which needs a couple of changes before I can input it into our master data set for reporting. These things need to happen (please refer to the picture):
The date needs to be expressed in the formation "mmm-yy". I've tried to add "01/" to make "01/04/2017" (I'm Australian so this is the 1st of April), but for some reason it automatically changes it to 04/01/2017. Ultimately, I need 04/2017 to go to Apr-17 for all data in the column
"Medical Div" change to "Medical" and "Mental Health Div" change to "Mental Health" - i've already sorted a macro for this, but not sure how to combine it with another macro for the other functions I'm wanting.
If anyone can help providing code or links to good resources which will allow me to perform all these functions at once with one macro that would be great.
Thanks
This can easily be done with Power Query instead of VBA. Power Query is a free add-in from Microsoft for Excel 2010 and 2013 and built into Excel 2016 as "Get and Transform". Conceptually, the steps are:
Load the data
insert a new column with a formula that combines the text "1/" with the column Month-Year
change the type of the new column to Date
remove the old Month-Year column
select the Division column
replace " Div" with nothing
Save the query
When new data gets added to the original data source, just refresh the query. All this can be achieved by clicking icons and buttons in the user interface. No coding required.
Well, for point 2, how about recording a macro and using Find and Replace twice?
This should combine them into a macro for you. Then you can copy paste that elsewhere.
As for the date, Excel has an predisposition to convert to US format. Try this first (assuming "Month-Year" column is B)
Range("B2") = DateValue(Range("B2"))
Then apply formatting later.
Private Sub mySub()
Dim myRng As Range
Dim r As Range
Dim LastRow As Long
Dim mySheet As Worksheet
Dim myFind1, myFind2 As Variant
Dim myReplace1, myReplace2 As Variant
'This will get the number of rows with value in the sheet
LastRow = Sheets("Sheet1").UsedRange.Rows.Count
'This is for the first find and replace. It will search all cells with exact value of "Medical Div" in the sheet and change it to "Medical".
myFind1 = "Medical Div"
myReplace1 = "Medical"
'This is for the second find and replace. It will search all cells with exact value of "Mental Health Div" in the sheet and change it to "Mental Health".
myFind2 = "Mental Health Div"
myReplace2 = "Mental Health"
'This will loop through the entire column with the date that needs to have the format mmm-yy. It will convert the 04/2017 to date format first before making it Apr-17.
With Sheets("Sheet1")
Set myRng = Sheets("Sheet1").Range("A2:A" & LastRow)
For Each r In myRng
r.Value = CDate(r.Value)
Next r
End With
myRng.NumberFormat = "mmm-yy"
'This will loop through the active worksheet and apply the find and replace declared above.
For Each mySheet In ActiveWorkbook.Worksheets
mySheet.Cells.Replace what:=myFind1, Replacement:=myReplace1, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
mySheet.Cells.Replace what:=myFind2, Replacement:=myReplace2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next mySheet
End Sub
Here is a code that you could try.
It will change the date format of the column with Month-Year to
"Apr-17" regardless of the current date format.
It will also find and replace the Medical Div and Mental Health Div
to "Medical" and "Mental Health".
You will need to change the range to suit your needs. I have set the column for the month-year to column A. You must change it to column B if that is where your dates are.
This is my data before running the macro:
Here is my data after running the macro:
Related
This is a hack-y Excel question, certainly not standard procedure. Apologies in advance.
Inside a workbook, I have a financial model. It spans three sheets: Revenue and Expense, which both read information from Inputs. Together, the sheets form a complete model.
I want to expand my workbook by creating a duplicate model alongside my first one. The idea is to have side-by-side scenarios that I can compare. 2 sets of inputs, 2 sets of expense calcs, and 2 sets of revenue calcs, each set side-by-side on its respective tab.
Normally, I would just copy the formulas over and 'bam' I've got a duplicate model. Unfortunately, I can't do this because I used a ton of $ characters, locking my cell references. Copying the formulas in Revenue off to the right wouldn't change which cells the formulas reference on Inputs tab. The model is large enough that it would take hours to remove the cell reference locks from each formula manually.
My current plan is to use VBA to remove all of the $ characters from formulas and then go ahead with the copy pasting method.
Will this work?
How can I remove a specific character from formulas using VBA?
You can press ctrl+' this will change all the cells from showing their value to showing their formula. In this view you can press ctrl+H to replace all $ with nothing and click "Replace All".
So no need to code it all in vba, which would have been possible too, but probably a bit more complicated.
This will remove all the dollar signs you wanted to remove.
Pay attention though if you make any edits extrapolating formulas in the new dollar-sign-less sheet, that it will probably be incorrect for it will also extrapolate the set references which should contain a $.
For removing the $ in external link paths in Excel -
Sub ExtLinks_RelativePaths()
This macro converts external links in selected cells to relative links by removing the $ from the cell reference
' Source: todd.kluge#merrillcorp.com
Dim myCells As Range, curCell As Range
Dim myVal As Boolean
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set myCells = ActiveSheet.UsedRange
On Error Resume Next
For Each curCell In myCells
curCell.Select
myVal = IsFormula(curCell)
If myVal = True Then
With Selection
.replace What:="$", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
End If
Next curCell
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox ("Formulas on the active sheet now have relative references.")
End Sub
Function IsFormula(cell_ref As Range)
IsFormula = cell_ref.HasFormula
End Function
Intent
It will consist of 11 identical Worksheets (10 for data entry specific areas of the site being worked on, and 1 "Master" which gathers the totals)
The Master Worksheet is where the Start Date is changed. When the Start Date is changed it is reflected in the 10 data entry Worksheets. There are numeric values as well showing how far away the Start Date is.
When the Start Date is changed, the values need to move with the Start Date (i.e. if the Start Date is January 5 and there is already data on the data entry worksheets, if the Start Date is changed to January 7 then all data on all worksheets will need to move to the right by 2)
Intended Process
I was able to get the first two functions working, however it's the last one that's causing some grief.
What I had in mind was a procedural copy-paste of sorts. When the Start Date is changed it would go to the first data entry worksheet and copy the current header settings to a "Transfer" Worksheet, preserving the original date settings for that worksheet. It would then delete the data in the data entry worklist.
The next step was to go to the first of the data entry Worksheets (Codenames in the background start with "Sz"), match the first numeric value of the data entry to the Transfer worksheet, retrieve the data and paste the column data into it's new location.
When it's all done with the data entry worksheet it would then clear out the "Transfer" worksheet, move to the next data entry worksheet, and repeat the process.
Problem
Unfortunately, the code I have written is saying it is finding the numeric values, when that numeric value doesn't exist. And then it sometimes has an error message stating "Code execution has been interrupted".
I have been working on this for about fifteen hours overtime, in addition to about a full week. I have googled countless potential solutions, and tried many workarounds, but am officially at a dead end. I have mostly taught myself through other people's examples, so I'm not an expert in Excel VBA.
If I can get the matching functions working correctly, I believe I should be able to handle the rest, but suggestions on more efficient methods are more than welcome.
I don't use Forums much, but I'll try to paste the code below.
Please let me know what other information I could provide.
Edit: Here is the sample of the Workbook. To run the function you will need to be on the "Plant" worksheet (Sz001): Dropbox Link
Code:
Sub Test()
Dim sh As Worksheet, flg As Boolean
For Each sh In Worksheets
'FUNCTIONAL: If sh.CodeName Like "Sz0*" Then 'flg = True
If sh.CodeName = "Sz001" Then 'Isolating a single Worksheet for testing
'Copy original values and location to Transfer Worksheet
'DISABLED THIS SECTION WHILE TESTING
'sh.Select
'ActiveSheet.Range("H8:ABI460").Copy
'Worksheets("Transfer").Select
'ActiveSheet.Range("H8").PasteSpecial xlPasteValues
'Begin Matching Loop -THIS IS WHERE THE ISSUES ARE HAPPENING
Dim xlRange As Range 'Current sh Range
Dim xlSheet As Worksheet 'Current sh Worksheet
Dim xlCell As Range 'Cell function is currently looking at
Dim x As Range
Set xlSheet = sh
Set xlRange = xlSheet.Range("H6:ABI6")
For Each xlCell In xlRange
Set x = ActiveSheet.Cells.Find(what:=xlCell, after:=Worksheets("Transfer").Range("G6"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If Not x Is Nothing Then
MsgBox Cells(xlCell.Row, xlCell.Column) & "Found"
Else
MsgBox Cells(xlCell.Row, xlCell.Column) & "Not Found"
End If
Next xlCell
End If
Next
End Sub
Tested:
Option Explicit
Public Sub Test()
Const WS_TR As String = "Transfer" 'Sheet Transfer
Const WS_RNG As String = "H6:ABI6" 'row 6 on both sheets
Dim wsSz As Worksheet, wsTr As Worksheet, cel As Range
Dim found As Range, row6Sz As Range, row6Tr As Range
Set wsSz = Sz001 'Code Name for the sheet "Sz001"
Set wsTr = Worksheets(WS_TR)
Set row6Sz = wsSz.Range(WS_RNG) 'searched values
Set row6Tr = wsTr.Range(WS_RNG) 'search area
For Each cel In row6Sz 'searched values
Set found = row6Tr.Find(what:=Val(cel.Value2), LookIn:=xlValues, _
LookAt:=xlWhole, SearchFormat:=False, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Debug.Print cel.Value2 & IIf(Not found Is Nothing, " Found", " Not Found")
Next
End Sub
.
Note:
I replaced the MsgBox with Debug.Print
For results press Ctrl+G, or View -> Immediate Window
I'm trying to automate a process that takes a monthly report and generates an exception report based on the data. Since the volume of the data in the report varies from month to month, i need to account for that. What methodology is best for referencing a variable range?
For example, instead of referencing the range A1:F7087, i want to reference the entire range that includes any data. For as simple as this appears to be, I haven't been able to find any guidance on it. Appreciate any input. Thanks
Dim rng As Range
Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
This will set rng to contain all cells up to last filled, it will also contain all empty rows and columns.
You should also read this, important part from this article about xlLastCell:
Depending on what you are trying to accomplish, this cell may not be the cell that you are actually looking for. This is because, for example, if you type a value into cells A1,A2, and B1, Excel considers the last cell to be B2, which could have a value or not...
There are pros and cons with just about any method you choose to reference the dynamic block of data you wish to include with your report.
The caveat that comes with .SpecialCells(xlLastCell) is that it may encompass a cell that was previously used but is no longer within the scope of the data. This could occur if your data shrinks from one month to the next although recent service packs and updates provided for Excel 2010/2013 will shrink the rogue last cell through saving the workbook. I'm sure many of us have at one time or another mistyped a value into AZ1048576 and had to jump through hoops getting Excel to internally resize the extents of the actual data. As mentioned, with later versions of Excel, this problem is all but a footnote in history.
One last thing to note is that cells formatted as anything but plain-Jane General will halt the shrink so if last month's report had a formatted Subtotal line 50 rows below where it is this month, the .SpecialCells(xlLastCell) will be referencing an area 50 rows too long.
If you have a contiguous block of data with some blank cells possible but no fully blank rows or columns that segregate your data into islands then I prefer the following approach.
With sheets("Sheet1")
Set rng = .Cells(1, 1).CurrentRegion
End With
The area referenced by the above code can be demonstrated by selecting A1 and tapping Ctrl+A once (twice is A1:XFD1048576). The cells selected will be a rectangle encompassing the last column with data and the last row with data as the extents. Previously used cells and cells that have retained formatting from previous reports have no effect; only cell values and formulas. However, it must be emphasized that the island of data stops at the first fully blank row or column.
The last method I will mention is to position in (aka .Select or otherwise start at) A1 and use .Find with a wildcard searching backwards so that it ends up starting at XFD1048576 and searching toward A1 for the first value or formula it can find first by row then repeated by column.
Dim lr As Long, lc As Long, rng As Range
With Sheets("Sheet3")
lr = .Cells.Find(What:=Chr(42), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lc = .Cells.Find(What:=Chr(42), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set rng = .Cells(1, 1).Resize(lr, lc)
End With
This is really the only true method of getting an accurate representation of your data block but its thoroughness is not usually necessary.
Sub highlight()
Dim obj As Range
For Each obj In Sheet1.UsedRange
If obj.Value = Range("A1").Value Then
obj.Interior.Color = vbYellow
Else
obj.Interior.Color = vbWhite
End If
Next obj
End Sub
I'm currently building a small project planner in Excel that uses the current date to plot coloured blocks under a date column to depict which stage of the project we are currently at for a particular customer (see image below).
Behind each of the coloured blocks is a drop-down menu populated by a list on another sheet. My aim is to search for the current date in cell A1 ( populated using today() ) within all columns that follow the freezed panes (depicted by the black right hand border). When the current date is found, the value of in each of the coloured blocks should be copied into the corresponding cells so that as the project progresses, a line of coloured blocks are entered for each day (with the relevant text from the drop-down depicting the current stage of that block).
Currently I am using the following formula copied into all cells that follow the freeze:
=IF(F$1 = $A$1,$C2,"")
However, when the current date is changed this merely moves the copied blocks across to the relevant column without maintaining the old values from previous days.
I've also attempted this with a VLOOKUP so that I can enter it into a macro and run if from a button but the layout does not allow for a successful VLOOKUP.
The simplest solution I believe would be to have a button that allows the user to save the current state of the column with a header that matches the current date however it has been some time since I have coded in VBA and do not remember how to do this.
Any ideas? Thanks in advance.
Not sure if this is exactly what you're looking for, but here goes...
Sub ColorCode()
Dim ws As Worksheet
Dim rng As Range
Dim cel As Range
Set ws = ThisWorkbook.Sheets("SheetNameHere")
Set rng = ws.Range("F1:I1")***
For Each cel In rng
If cel.Value = ws.Range("A1").Value Then
ws.Range("C2:C8").Copy
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteFormats
End If
Next
End Sub
If you add that to a new module, you can assign it to a command button. I haven't had a chance to test it, but it cycles through the dates in the first row to see if they match the date in A1. If they do, it copies over the values and formats from C2:C8(change if you need to) into the rows underneath that date. You may need to change some of the ranges to suit your specific worksheet.
So your requirements seem fairly straightforward to me:
you need the tracker to identify the column with today's date
you need to establish a permanent value for each day as it occurs
you need the color of today's values to be added to the cell, and stay that way even after today's date has passed.
The formula you cite in your question, if copied across all cells, will clearly just provide a value on the column for today's date, and unless you use a circular reference to let it self assess and update its value on today's date, it will not retain information when tomorrow comes.
Your idea for a button would work if you want the user to control the time of update, or you could have code that runs either when the workbook opens or when the worksheet itself is activated (placing it in the appropriate object code under either Private Sub Worksheet_Activate() or Private Sub Workbook_Activate().
I think PermaNoob has a right idea of copying the value of the column and pasting the value (rather than the formlula) into that column, but what is missing is appropriate identification of the column containing today's date and the coloring of those cells (if you don't have some method of coloring them that you did not mention). Something like this might work either attached to a button as you suggest, or to the _Activate event as I suggest. This is untested but should give you an idea of how to approach it:
Sub UpdatePlanner()
'~~>dim variables and set initial values
Dim wb As Workbook
Set wb = Workbooks("NAME or INDEX of YOUR workbook")
Dim ws As Worksheet
Set ws = wb.Worksheets("NAME or INDEX of YOUR sheet")
Dim rngHeader As Range
Set rngHeader = ws.Range("F1", ws.Range("F1").End(xlToRight))
Dim rngDate As Range
Dim rngColumn As Range
Dim rngCell As Range
'~~>loop to find the column with today's date
For Each rngDate In rngHeader
If rngDate.value = ws.Range("A1").value Then
Set rngColumn = ws.Range(rngDate.Address, _
ws.Range(rngDate.Address).Offset(65536, 0).End(xlUp)) 'this assumes
'your column may not have a value in every row
Exit For
End If
Next rngDate
'~~>copy and paste the column values and formats
With rngColumn
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'~~>loop to add the color formatting (since I don't see this in your formula)
For Each rngCell In rngColumn
If rngCell.value = ws.Range(Cells(rngCell.Row, 3)).value Then
rngCell.Interior.Color = _
ws.Range(Cells(rngCell.Row, 3)).Interior.Color
End If
Next rngCell
End Sub
I am trying to make a macro that will go through a whole workbook and count the number of days a employee worked. The sheets have the work broken out in days so all T have to find is the days that are not zero. I have tried to use COUNTIF(A11:A12,">0") and I get the error Expected : list separator or ). I am using a For Each loop to work through the sheets. I would like to put all the information on a new sheet at the end of the workbook with the name of the employee and the days worked. I am very new to visual basic but am quite good with c#.
I now have gotten this far
Option Explicit
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
Dim LastColumn As Integer
If WorksheetFunction.CountA(Cells) > 0 Then
' Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
Current.Range("A27") = Application.WorksheetFunction.CountIf(Current.Range(Cells(11, LastColumn), Cells(16, LastColumn)), ">0")
Current.Range("A28") = Application.WorksheetFunction.CountIf(Current.Range("Al17:Al22"), ">0")
Next
End Sub
When I run this I get an error saying method range of object'_worksheet' failed. I also haven't been able to find a way to get the information all on the summary sheet.
VBA Solution, in light of your last comment above.
Good VBA programming practice entails always using Option Explicit with your code, that way you know when you don't have variables declared correctly, or, sometimes, if code is bad! In this case you would have picked up that just writing A27 does not mean you are returning the value to cell A27, but rather just setting the value you get to variable A27. Or maybe you wouldn't know that exactly, but you would find out where your problem is real quick!
This code should fix it for you:
Option Explicit
Sub WorksheetLoop2()
'Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
Current.Range("A27") = Application.WorksheetFunction.CountIf(Current.Range("A11:A12"), ">0")
Next
End Sub
In case it helps, Non-VBA solution:
Assuming you have a Summary sheet and each employee on a separate sheet, with days in column A and hours worked in column B, enter formula in formula bar in B1 of Summary and run down the list of names in column A.