Wording my question is slightly tricky so I've included screen-shots to make this easier. I have 2 separate spreadsheets which are currently not linked together in anyway. What I've been asked to do is:
For the drop-downs which have a * next to them, have this * drop-down get converted into a acronym (I.e. If it's Home Visit *, then this will be converted to HV), and have it automatically entered into Cell Position X. Please refer to Image 1 then Image 2)
So the user would click on Sheet one, select the relevant drop-down field and then assign how much time that task took. The second sheet would then update itself with this information - it would insert the users name, program and activities. This is where it gets very tricky. Based off the drop-down selection, if it is asterisked (*), then based off the field-type it will convert it into a set acronym which would then be placed in one of the data fields based off the entry date that has been provided.
I designed both spread-sheets and they have macros in the background, but I can't seem to work out how to best perform this. Would you suggest a transpose function which checks firstly the date criteria and then an INDEX(MATCH) function to match the criteria against a pre-defined name-range which converts Home Visit etc. to HV automatically? I'm also unsure of how to insert delimiters for each new entry that is read. If anyone can provide help I would be very grateful.
I'm not 100% sure I understand your question, but here goes:
What about adding a Worksheet_Change event to look for changes in the drop-down's cell, and then converting it to an acronym?
Place the following code inside the sheet of interest:
Private Sub Worksheet_Change(ByVal Target As Range)
'If Cell A1 is changed, put the acronym into A2
If Target.Row = 1 And Target.Column = 1 Then
Cells(2, 1) = GetAcronym(Target.Value)
End If
End Sub
Function GetAcronym(TheText As String) As String
Dim result As String
Dim x As Long
'Always grab the first letter
result = Mid(TheText, 1, 1)
'Get the other letters
For x = 2 To Len(TheText) - 1
If Mid(TheText, x, 1) = " " Then result = result & Mid(TheText, x + 1, 1)
Next x
GetAcronym = UCase(result)
End Function
Related
enter image description hereI Have two Excel Sheets ("Record") & ("Register"), " Register" is the database. from this database I need to create Records of each employees based on their employee ID (cell value). i am searching for a VBA code that should give me the training Record a each employee once i have enter their ID in the cell and click "a command button". Attached the Excel screen short for reference.
Steps 1: Enter Employee ID in the "Record" sheet
Step 2: Click command button "Filter" in the Record sheet
Step 3: VBA code to run and filter data from "Register" and fill "Record".
IF i Type another Employee ID in the sheet "Record" , it should ClearContents of the previous query. and produce the data.
Please help me, i am not good in VBA .attached the Excel screen short for reference ( UPDATE on 29/07/2018-Question Solved : sharing the code below; thank you Mr.ComradeMicha for your valuable feedback)
Sub Button2_Click()
'Declare the variables
Dim RegisterSh As Worksheet
Dim RecordSh As Worksheet
Dim EmployeeRange As Range
Dim rCell As Range
Dim i As Long
'Set the variables
Set RegisterSh = ThisWorkbook.Sheets("Register")
Set RecordSh = ThisWorkbook.Sheets("Record")
'Clear old data Record Sheet
RecordSh.Range("A8:F107").ClearContents
Set EmployeeRange = RegisterSh.Range(RegisterSh.Cells(6, 4), RegisterSh.Cells(Rows.Count, 6).End(xlUp))
'I went from the cell row6/column4 (or D6) and go down until the last non empty cell
i = 7
For Each rCell In EmployeeRange 'loop through each cell in the range
If rCell = RecordSh.Cells(4, 2) Then 'check if the cell is equal to "Record"
i = i + 1 'Row number (+1 everytime I found another "Record")
RecordSh.Cells(i, 1) = i - 7 'S No.
RecordSh.Cells(i, 2) = rCell.Offset(0, 2) 'Training name
RecordSh.Cells(i, 3) = rCell.Offset(0, -2) 'End date
RecordSh.Cells(i, 4) = rCell.Offset(0, 6) 'Validity
RecordSh.Cells(i, 5) = rCell.Offset(0, 7) 'Remarks
RecordSh.Cells(i, 6) = rCell.Offset(0, 5) 'Minimal requirement
End If
Next rCell
End Sub
Your code is missing a few essential parts you may want to look into:
It seems to require the user to select a specific row before the macro is started, even though there is a command button to trigger the macro. If the layout stays the same, just use constants to store the row where certain input or lookup fields are located.
ra is used both on the input form and on the lookup sheet. That's asking for trouble... Again, use constants or at least "StartingRow=3" or something similar.
You are correcting your employee number to a format that doesn't fit the data provided in the screenshot. Hopefully just a dummy data issue, but in case you are wondering why you don't find anything ;)
You are typecasting all fields individually. If your layout is always the same, it's much easier to just use the "variant" type for all cell values and make sure you already formatted all columns correctly.
ru is never initialized? It's supposed to be "the next row", why not simply use "ra+1" then instead of ru? Also, TRNRow and RTRNRow are never initialized either.
When you "search" your records, you actually only copy the same row into your results, then "copy next row until employee number is wrong". So this only works for exactly one employee, and even then you only catch the first few trainings. Use the Find function on the employee number cell in the records sheet to find the next row with that id, then copy the row's contents and find next.
I think if you get yourself aquainted with the Find function, you will easily finish this macro on your own. Here's a good guide: https://excelmacromastery.com/excel-vba-find
Good luck!
I've got an Excel sheet with my variables listed in column E and their values listed in column G
I would like to test if E contains the word "text" (my variable). If so then I want to replace the corresponding cell in column G with "This is my successful if statement text".
If not -- I want the cell to either be left alone (impossible in excel) or keep the value it originally had (I think the issue is its populated with text not numbers).
So far ive tried
=if(e2="text", "Replace with this", G2)
as well as
=if(e2="text", "replace with this", "")
The top returns a number while the bottom returns an empty cell which deletes the contents I had there.
Any suggestions? I think this can be done with VB but that's out of my league.
The proper way to solve this is as so.
In column H (or any that doesn't contain any information) place the formula
=IF(E2 = "text", "This is the true part", G2) and drag down.
This will test E2 for the word "text" and then replace with "this is true.." If the conditions are not met, the original text from G2 is pulled into the new column.
Once this is complete, the desired results should have taken effect. You can then copy the row and use "Paste Special" and select "Values" from the pop up menu to paste in your new data. Selecting Values allows the user to paste the actual field data, not the formula that generated it!
Try this.
Sub g()
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1") 'change sheet name as applicable
lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
For i = 1 To lastRow
With ws
If .Cells(i, 5) = "text" Then
.Cells(i, 7) = "The text you want"
End If
End With
Next
End Sub
It seems like you are trying to get four values from column E that you want to parse (cut up) and place in Column G.
By creating four parses { =mid(e2,16,10), =mid(e3, 9, 15), =mid(e4,5,3), =mid(e5,10,22) } in cells G2, G3, G4, and G5, respectively, you can select the block of four G cells (G2:G5), select the block at the bottom right, and drag it down throughout the file.
Optionally, you can use modulo math and case statements to loop through the file and perform the required function at each point:
myCount = 0
myLoop = 0
endMyLoop = false
range("G2").activate
do
myLoop = myCount mod 4
select case myLoop
case 0
code for description_tag
case 1
code for title_tag
case 2
code for headline
case 3
code for text
end select
if activecell.value = "" then endMyLoop = true
loop until (endMyLoop = true)
You stated that every fourth row the value in E is text. So, it should just be a matter of copying the formula every fourth row or performing your function every fourth iteration (modulo returns the remainder) in the G column.
One other option would be to nest your if loops (=if(e2="text","Its text",if(e2="title_tag","Its a title",if(e2="headline","Its headline","Its description")))) to account for the four different options. Of course you would fill the text with the function that you actually want to perform.
The data I have can be simplified to this:
http://i.imgur.com/mn5GgrQ.png
In this example, I would like to delete the data associated with track 2, since it has only 3 frames associated with it. All data with more than 3 associated frames can stay.
The frame number does not always start from 1, as I've tried to demonstrate. The track number will always be the same number consecutively for as many frames as are tracked. I was thinking of using a function to append 1 to a variable for every consecutive value in column A, then performing a test to see if this value is equal >= 3. If so, then go onto the next integer in A, if no, then delete all rows marked with that integer (2, in this case).
Is this possible with Visual Basic in an Excel Macro, and can anyone give me some starting tips on what functions I might be able to use? Complete novice here. I haven't found anything similar for VBA, only for R.
I assume you understand the code by reading it.
Option Explicit
Public Function GetCountOfRowsForEachTrack(ByVal sourceColumn As Range) As _
Scripting.Dictionary
Dim cell As Range
Dim trackValue As String
Dim groupedData As Scripting.Dictionary
Set groupedData = New Scripting.Dictionary
For Each cell In sourceColumn
trackValue = cell.Value
If groupedData.Exists(trackValue) Then
groupedData(trackValue) = cell.Address(False, False) + "," + groupedData(trackValue)
Else
groupedData(trackValue) = cell.Address(False, False)
End If
Next
Set GetCountOfRowsForEachTrack = groupedData
End Function
Public Sub DeleteRowsWhereTrackLTE3()
Dim groupedData As Scripting.Dictionary
Set groupedData = GetCountOfRowsForEachTrack(Range("A2:A15"))
Dim cellsToBeDeleted As String
Dim item
For Each item In groupedData.Items
If UBound(Split(item, ",")) <= 2 Then
cellsToBeDeleted = item + IIf(cellsToBeDeleted <> "", "," + cellsToBeDeleted, "")
End If
Next
Range(cellsToBeDeleted).EntireRow.Delete
End Sub
GetCountOfRowsForEachTrack is a function returning a dictionary (which stores track number as key, cell address associated with that track as string)
DeleteRowsWhereTrackLTE3 is the procedure which uses GetCountOfRowsForEachTrack to get the aggregated info of Track numbers and cells associated with it. This method loops through the dictionary and checks if the number of cells associated with track is <=2 (because splitting the string returns an array which starts from 0). It builds a string of address of such cells and deletes it all at once towards the end.
Note:
Add the following code in a bas module (or a specific sheet where
you have the data).
Add reference to "Microsoft Scripting.Runtime" library. Inside VBA, click on "Tools" -> "References" menu. Tick the "Microsoft Scripting.Runtime" and click on OK.
I have used A2:A15 as an example. Please modify it as per your cell range.
The assumption is that you don't have thousands of cells to be deleted, in which case the method could fail.
Make a call to DeleteRowsWhereTrackLTE3 to remove such rows.
My Goal: To get all data about the same subject from multiple reports (already in the same spreadsheet) in the same row.
Rambling Backstory: Every month I get a new datadump Excel spreadsheet with several reports of variable lengths side-by-side (across columns). Most of these reports have overlapping subjects, but not entirely. Fortunately, when they are talking about the same subject, it is noted by a number. This number tag is always the first column at the beginning of each report. However, because of the variable lengths of reports, the same subjects are not in the same rows. The columns with the numbers never shift (report1's numbers are always column A, report2's are always column G, etc) and numbers are always in ascending order.
My Goal Solution: Since the columns with the ascending numbers do not change, I've been trying to write VBA code for a Macro that compares (for example) the number of the active datarow with from column A with Column G. If the number is the same, do nothing, else move all the data in that row (and under it) from columns G:J down a line. Then move on to the next datarow.
I've tried: I've written several "For Each"s and a few loops with DataRow + 1 to and calling what I thought would make the comparisons, but they've all failed miserably. I can't tell if I'm just getting the syntax wrong or its a faulty concept. Also, none of my searches have turned up this problem or even parts of it I can maraud and cobble together. Although that may be more of a reflection of my googling skill :)
Any and all help would be appreciated!
Note: In case it's important, the columns have headers. I've just been using DataRow = Found.Row + 1 to circumvent. Additionally, I'm very new at this and self-taught, so please feel free to explain in great detail
I think I understand your objective and this should work. It doesn't use any of the methodology you were using as reading your explanation I had a good idea how to proceed. If it isn't what you are looking for my apologies.
It starts at a predefined column (see FIRST_ROW constant) and goes row by row comparing the two cells (MAIN_COLUMN & CHILD_COLUMN). If MAIN_COLUMN < CHILD_COLUMN it pushes everything between SHIFT_START & SHIFT_END down one row. It continues until it hits an empty row.
Sub AlignData()
Const FIRST_ROW As Long = 2 ' So you can skip a header row, or multiple rows
Const MAIN_COLUMN As Long = 1 ' this is your primary ID field
Const CHILD_COLUMN As Long = 7 ' this is your alternate ID field (the one we want to push down)
Const SHIFT_START As String = "G" ' the first column to push
Const SHIFT_END As String = "O" ' the last column to push
Dim row As Long
row = FIRST_ROW
Dim xs As Worksheet
Set xs = ActiveSheet
Dim im_done As Boolean
im_done = False
Do Until im_done
If WorksheetFunction.CountA(xs.Rows(row)) = 0 Then
im_done = True
Else
If xs.Cells(row, MAIN_COLUMN).Value < xs.Cells(row, CHILD_COLUMN).Value Then
xs.Range(Cells(row, SHIFT_START), Cells(row, SHIFT_END)).Insert Shift:=xlDown
Debug.Print "Pushed row: " & row & " down!"
End If
row = row + 1
End If
Loop
End Sub
I modified the code to work as a macro. You should be able to create it right from the macro dialog and run it from there also. Just paste the code right in and make sure the Sub and End Sub lines don't get duplicated. It no longer accepts a worksheet name but instead runs against the currently active worksheet.
I am trying to implement a lookup feature in Excel Vba. I do not have any code to share because I am uncertain how to begin with the implementation.
Upon opening a workbook I want to use VBA to enter today's date into the next available row in column A - which I currently have working now. However, at that point in Column B on that same line, I to find a stock rate in a table I have, where J2 is the date and J3 is the price of the stock.
What I think I need is a formula where I can lookup the date I just added in this table and then retrieve the price relevant to that date. I understand Vlookups in Excel very well; it is I just do understand how to use a lookup here for each next available line.
Here is my code for the dates:
Dim rnum as integer
rnum = sheet17.usedrange.cells.rows.count +1
sheet17.cells(rnum, 1).value = date
I am seeking lookup functionality relative to (rnum, 2) as the next available line.
If you want to hardcode it, that'd be
sheet17.cells(rnum, 2).formula = "=vlookup(" & sheet17.cells(rnum, 1).address(false,false,xlA1) & ", $J:$K, 2, false)"
If you would prefer to use whatever formula is on the previous line,
sheet17.range(sheet17.cells(rnum-1, 2), sheet17.cells(rnum, 2)).FillDown
I'm assuming when you say "stock rate in a table" you mean "stock rate in a worksheet" and also assume that the values in column J contain the stock rates for the same stock. In other words, you are only matching on a date in that column and not the stock symbol AND the date. (Please let me know if I have these assumptions wrong).
That being, said you can try the following formula in column B:
=IF(A50<>"",INDEX(J:J,MATCH(A50,StockSheet!J:J,0) +1),"")
In this case, the formula is in cell B50 and assumes the new date is in A50. It says given the date value in cell J + n, give me the value in cell J + n + 1.
I added a small validation check to see if there was a value in A50, but you may want to go deeper than that.
Also, if you want to make the value in B50 static, then just use the following code:
Sub mySub()
Dim x As Range 'I assume this range will be for your currentm, working worksheet
Set x = Range("B50", "B50")
x.Formula = "=IF(A50<>"""",INDEX(J:J,MATCH(A50,Codes!J:J,0) +1),"""")"
x = x.Value
End Sub