I have a spreadsheet that a user enters/manages data in. They will insert rows, maybe copy rows and then input data.
There is a column, that holds MembID values, and the values for this are assigned when user clicks button to run a macro.
Every now and again the macro detects that it has duplicate values in the column and I am struggling to see how this could be possible and suspect that the user is manually entering values in the column.
I would like to be able to detect if they are entering data into a cell in that column. Any detection method needs to be able ignore changes made to the column by the macro! Is this possible to do?
I have managed to do 90+% of what I needed with the following code.....
Option Explicit
Public Sub Worksheet_Change(ByVal target As Range)
Dim intersection As Range
Dim ThisCell As String
Dim iRowFirst As Integer
Dim iRow As Integer
Dim iCol As Integer
Dim sMessage As String
Dim iNoRows As Integer
Dim iMembColMembID As Integer
Dim iMembHeaderRow As Integer
' Find Column headings for "Membership" sheet
iMembHeaderRow = 1
Call FindHeader("Membership", iMembColMembID, iMembHeaderRow, "MembID")
Set intersection = Intersect(target, Range(Cells(1, iMembColMembID), Cells(2000, iMembColMembID)))
If Not intersection Is Nothing Then
iRowFirst = target.Row
iNoRows = target.Rows.Count
sMessage = ""
For iRow = iRowFirst To iRowFirst + iNoRows - 1
ThisCell = Cells(iRow, iMembColMembID)
If ThisCell <> "" Then
If sMessage = "" Then
sMessage = "The value for MembID has been changed for following row(s): "
End If
sMessage = sMessage & iRow & " "
End If
Next iRow
If sMessage <> "" Then
MsgBox sMessage
End If
End If
End Sub
I also put Application.EnableEvents.False at start of macro that adds new MembID values and then reenabled it at end of macro.
This detects the user adding data to the MembID column.
The only odd things are that if you copy/insert a number of rows then you will get 2 messages as the macro is triggered twice. Also, it will trigger if you delete a row.
But, in the grand scheme of things, then I can live with that!
Related
I have a financial data with serial numbers linked to asset. The serial numbers are listed in cell through line breaks, i.e. there could 3,4,5 etc. serial no in a cell. So, the idea is copy and insert rows based on how many serial numbers are linked to asset in selected range. i.e. if there 4 serial no, then row should be split into 4 rows. The issue my code is that once I'm selected the range to be split, no matter that 3 or more serial numbers exist in first row it's slit into two rows, but the rest cells in range are split correctly. Not sure why the cycle within first cell in a range ends wrong.
Public Sub separate_line_range()
Dim target_col As Range
myTitle = "Select cells to be split"
Set target_col = Application.Selection
Set target_col = Application.InputBox("Select a range of cells that you want to split", myTitle, target_col.Address, Type:=8)
ColLastRow = target_col
Application.ScreenUpdating = False
For Each rng In target_col
If InStr(rng.Value, vbLf) Then
rng.EntireRow.Copy
rng.EntireRow.Insert
rng.Offset(-1, 0) = Mid(rng.Value, 1, InStr(rng.Value, vbLf) - 1)
rng.Value = Mid(rng.Value, Len(rng.Offset(-1, 0).Value) + 2, Len(rng.Value))
End If
Next
ColLastRow2 = target_col
For Each Rng2 In target_col
If Len(Rng2) = 0 Then
Rng2.EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Please find imagine below:
I don't exactly know your task, so I put something relatively close to your task.
The issue of not correctly loop through all row is because the "RNG" you selected will not be resized after each insert row.
e.g. You are selecting row A1:C20, and there are two row added. Now the #19 and #20 are now A21:C21 & A22:C22. But the RNG is still A1:C20. The final two row will not be within the loop.
To solve your issue,
Use For i = LastRow to First Row Step -1 (Next) instead of For Each (Loop)
Here is something I do similar to your task (What I believe)
Sub Insertrow()
Dim i As Integer
Dim Lastrow As Integer
Lastrow = Worksheets("FMS1").Cells(1, 12)
For i = Lastrow To 1 Step -1
If Worksheets("FMS1").Range("J" & i) <> Worksheets("FMS1").Range("J" & i + 1) Then
Worksheets("FMS1").Range("J" & i + 1).EntireRow.Insert
Else
End If
Next
End Sub
Imagine the following data
and the following code
Option Explicit
Public Sub SplitLineBreaksIntoCells()
Const MyTitle As String = "Select cells to be split" ' define it as constant
Dim TargetCol As Range
On Error Resume Next ' next line errors if user presses cancel
Set TargetCol = Application.InputBox("Select a range of cells that you want to split", MyTitle, Application.Selection.Address, Type:=8)
On Error GoTo 0
If TargetCol Is Nothing Then
' User pressed cancel
Exit Sub
End If
Dim iRow As Long
For iRow = TargetCol.Rows.Count To 1 Step -1 ' loop from bottom to top when adding rows or row counting goes wrong.
Dim Cell As Range ' get current cell
Set Cell = TargetCol(iRow)
Dim LinesInCell() As String ' split data in cell by line break int array
LinesInCell = Split(Cell.Value, vbLf)
Dim LinesCount As Long ' get amount of lines in that cell
LinesCount = UBound(LinesInCell) + 1
' insert one cell less (one cell can be re-used)
Cell.Resize(RowSize:=LinesCount - 1).EntireRow.Insert Shift:=xlShiftDown
' inert the values from the spitted array
Cell.Offset(RowOffset:=-LinesCount + 1).Resize(RowSize:=LinesCount).Value = Application.Transpose(LinesInCell)
Next iRow
End Sub
You will get this as result:
I would like to find the cells (or Rows) in Column B, Sheet1, who have matching values placed into ListBox2. Then, I'd like to change the value of a cell 4 columns over (using an Offset command).
I believe using a For loop is the most efficient way of going thru the values placed into ListBox2. I tried using a Forloop to go thru all values placed into ListBox2.List. Upon calling a value, the code would look for this value in Column B. Once found, it would "remember" the Row in which this value was found. Then, the code would use a Range/Offset command to change the value of a cell 4 columns over in that Row.
Private Sub ButtonOK_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim SerialList As Range
Dim SerialRow As Long
Dim i As Long
Set wb = ActiveWorkbook
Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim strFind As Variant
With ws
For i = 0 To Me.ListBox2.ListCount - 1
Set SerialList = ws.Range("B:B").Find(What:=Me.ListBox2.List(i))
SerialRow = SerialList.Row
If Not SerialList Is Nothing Then
ws.Range("B", SerialRow).Offset(0, 4).Value = Me.ListBox2.List(i) 'error occurs here!
MsgBox (ListBox2.List(i) & " found in row: " & SerialList.Row)
Else
MsgBox (ListBox2.List(i) & " not found")
End If
Next i
End With
End Sub
The MsgBoxes do say the correct ListBox2.List(i) value and the correct SerialList.Row, meaning that the program is correctly finding the row in which the list box value is located. However, I get an error saying that my range is not correctly defined at line "ws.Range("B", SerialRow)....."
How do I select the cell I'm searching for to correctly set it to =Me.ListBox2.List(i)?
Couple of fixes:
Dim lv
'....
For i = 0 To Me.ListBox2.ListCount - 1
lv = Me.ListBox2.List(i)
Set SerialList = ws.Range("B:B").Find(What:=lv, LookAt:=xlWhole) '<< be more explicit
'don't try to access SerialList.Row before checking you found a match...
If Not SerialList Is Nothing Then
ws.Cells(SerialList.Row, "F").Value = lv '<< Cells in place of Range
MsgBox (lv & " found in row: " & SerialList.Row)
Else
MsgBox (lv & " not found")
End If
Next i
It's not simple to get the values, don't know where to start to write a code
I added a picture with markings that will make it possible to explain the situation
so here I tell what I trying
the timevalues of red column with red arrow has to be in range al "hh:mm:ss"
but has also to stay in the original column as short date visible full value of original cel contains "dd:mm:yyyy hh:mm:ss" value also the first line in the filtered range rows"15:80015" must be skipped
second is the same of gray column with gray arrow has to be in am "hh:mm:ss"
but here the first cell has not to be skipped so that i can sum al-am timevalues and see when it has a difference of more than 10minutes
hope this helps to write code or is there a easy way to do this. that column S cell value +1 row sums column t cell value and put the value in range al am or an
when use column t is hidden, but now i put it visible to explain
so this must work when column t is hidden
code that i have for the moment is this
Private Sub CheckBox7_Click()
Call man
Dim rng As Range, cll As Range, i As Integer, al(80015) As Variant
'Dim i As Long
Dim cll2 As Range
Dim i2 As Long
'Dim lijnen As Range
'Dim lijnen2 As Range
Dim lijnen As String
Dim lijnen2 As String
Dim lstijd As String
Dim lstijd2 As String
Dim lstot As String
Dim lslijn As String
lijnen = "t15:t" & Range("t15").End(xlDown).Row
lijnen2 = "s16:s" & Range("s16").End(xlDown).Row
Application.ScreenUpdating = False
For Each cll In Range(lijnen).SpecialCells(xlCellTypeVisible)
If cll.Value <> "" Then
For Each cll2 In Range(lijnen2).SpecialCells(xlCellTypeVisible)
lstijd = Range("s" & cll.Row + cll2.Row - cll.Row)
Range("am" & cll.Row) = cll.Value
Range("al" & cll.Row) = lstijd
Next
End If
Next
lstijd = ""
Application.ScreenUpdating = True
Call oto
End Sub
I am trying to create a form which hopefully updates the list of values for a particular dropdown list automatically (without VBA codes) upon user's input immediately.
Here is the form that the user will see:
Currently, both Columns F and H is based on a data-validation formula:
INDIRECT("VList!"&SUBSTITUTE(ADDRESS(1,MATCH($B11,VList!$1:$1,0),1),"1","")&"2:"&SUBSTITUTE(ADDRESS(1,MATCH($B11,VList!$1:$1,0),1),"1","")&COUNTA(INDIRECT("VList!"&ADDRESS(1,MATCH($B11,VList!$1:$1,0),4)&":"&ADDRESS(100,MATCH($B11,VList!$1:$1),4))))
... where VList refers to the sheet as shown below:
So my question here is, based on the Project Name in Column B, is there a way to update the list in sheet VList with the value "Cost Per Unit" [Cell E11], so that the dropdown list in F12 and H12 get automatically updated with the value "Cost Per Unit"?
Been researching a long time for this with no avail, so I'm hoping to seek some experts here to see if such a scenario is even possible without VBA. Thanks!
Edit: So I've been told that VBA codes can be triggered automatically upon changes in the cell value, so I am open to any solutions/help with VBA as well. Will be researching on that direction in the meantime!
Edit2: Added a simple illustration below that hopefully better depicts what I'm trying to achieve on excel:
*Edit3: I'm starting to explore the Worksheet_SelectionChange method, and this is what I've come out so far:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim projectName As String
Dim VariableList As Worksheet
Dim Form As Worksheet
Dim thisRow As Integer
Dim correctColumn As Integer
Dim lastRow As Integer
Set VariableList = ThisWorkbook.Sheets("VList")
Set Form = ThisWorkbook.Sheets("Form")
On Error GoTo EndingSub
If Target.Column = 5 Then
thisRow = Target.Row
projectName = Form.Cells(thisRow, 2)
correctColumn = Application.Match(projectName, VariableList.Range("1:1"), 0)
lastRow = VariableList.Columns(correctColumn).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
VariableList.Cells(lastRow + 1, correctColumn).value = Form.Cells(5, thisRow).value
End If
EndingSub:
End Sub
Somehow the value of Form.Cells(5, thisRow).Value is always empty.
If I change it to Target.Value it still takes the previous value that was being input (e.g. I first put "ABC" as New Variable, it doesn't get updated. I changed New Variable to "DEF", it updates the list with "ABC" instead of "DEF"). It also takes ALL the values that are under Column E somehow.
Also, pressing Enter after I placed one input in E11 also causes both values of E11 and E12 to be updated when only E12 has been changed. However if I click away after E11 is being input, then only E11's value gets updated.
What exactly am I doing wrong here?
I was almost having fun with this one, if anyone can refine the screwed-up parts feel free to amend.
I furthermore recommend using tables. I do realise you can write lengthy formulae to refer to ranges but giving a name to your table gives an expanding list with a simple reference.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewVar As Range
On Error GoTo Err
Set NewVar = Range("C:C") 'data entered here, could be a referstorange kind of named range reference
If Application.WorksheetFunction.CountA(Intersect(Target, NewVar)) <> 0 Then Call ertdfgcvb(Target, NewVar) 'only run if there's an intersect, f*ed up but works anyway
Err:
End Sub
Sub ertdfgcvb(Target As Range, NewVar As Range)
Dim ws As Worksheet, Valid As Long, project As String, ListElmnt As String, Unlisted As Boolean, rng1 As Range, rng2 As Range
Set ws = Sheets("VList") 'the data that you refresh
Valid = 2 'projects in column B
HeaderRow = 1 'headers in Vlist are in row #1
uRow = Cells.Rows.Count 'f* yeah, compatibility considerations
For Each Cell In Intersect(Target, NewVar) 'will evaluate for each cell individually, in case you were to insert columns
ListElmnt = Cell.Value2 'stores the prospective list element
r = Cell.Row 'stores the list element's row to...
project = Cells(r, Valid).Value2 'identify the related project
HeaderRowRef = HeaderRow & ":" & HeaderRow
ColumnNum = ws.Range(HeaderRowRef).Find(What:=project, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns, LookAt:=xlWhole).Column 'finds the project in VList
'MsgBox ws.Name
Set rng1 = ws.Cells(HeaderRow + 1, ColumnNum)
Set rng2 = ws.Cells(uRow, ColumnNum)
LastRow = ws.Range(ws.Cells(HeaderRow + 1, ColumnNum), ws.Cells(uRow, ColumnNum)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'finds the last row for the project in VList 'f*ed up but works
Unlisted = True 'assumes it's unlisted
For x = HeaderRow + 1 To LastRow
If ListElmnt = CStr(ws.Cells(x, ColumnNum).Value2) Then Unlisted = False 'unless proven otherwise
Next
If Unlisted Then ws.Cells(LastRow + 1, ColumnNum) = ListElmnt 'if it's unlisted it gets appended to the end of the list
Next
End Sub
EDIT:
How to purge the table, example:
Sub ert()
Dim rng As Range
Set rng = Range("Táblázat1") 'obviously the table name
Do While x < rng.Rows.Count 'for each row
If rng(x, 1).Value2 = "" Then 'if it's empty
rng(x, 1).Delete Shift:=xlUp 'then delete but retaining the table format
Else
x = x + 1 'else go to the next line (note: with deletion comes a shift up!)
End If
Loop
End Sub
So I have this Excel workbook which basically is supposed to be a data sheet for work clothes for each employee. What I want is to have one sheet for each person (first name and last name), then one sheet for each clothing available.
Then one sheet to merge it all together. But, this would involve a repeat of each name as many times as there are unique cloth types. Hard to explain, but I've got a workbook available for download here:
http://www.mediafire.com/?dxurbdjq340su6j
Sheet2(Users) contains a simple list of each unique user. Sheet3(Articles) contains a list of each unique clothing article. And then finally we have the first Sheet(Summary) which contains a merged list of it all. Based on this Summary sheet, I'm gonna create a pivot table later. But first I need the functionality here to be dynamic. Whenever a new user or clothing is added or deleted, I only want to do this in Sheet2 or Sheet3. Whatever is in Sheet1 should collect the data dynamically.
Any idea? Would I have to create a macro to do this?
Edit: Ok, so I've created a module with two public Dictionaries. Here's the code I've got so far:
ThisWorkbook
Private Sub Workbook_Open()
' Create dictionaries
Set dictName = New Dictionary
Set dictClothItems = New Dictionary
' Collect data
collectDictName
collectDictClothItems
End Sub
Module1:
Public dictName As Dictionary
Public dictClothItems As Dictionary
Public Sub collectDictName()
Dim v As Variant
Dim rngName As Range
' Add values
With ThisWorkbook.Sheets(2)
Set rngName = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
For Each strName In rngName
dictName.Add strName, ""
Next
End With
End Sub
Public Sub collectDictClothItems()
Dim v As Variant
Dim rngName As Range
' Add values
With ThisWorkbook.Sheets(3)
Set rngName = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
For Each strClothName In rngName
dictClothItems.Add strClothName, ""
Next
End With
End Sub
So, here I collect the data and store these in an array. I wasn't sure how to collect the data from the range, so I used For Each strName In rngName. Looks like it collects other data that I really don't need as well. Can probably fix that up by creating a string variable and assigning the value I'm after to that. And then adding that string to the Dictionary. Anyways, now that the data's collected, I need to compare and add it to the actual Summary sheet now. Any idea on where to begin?
Question rephrasing
So basically, what you want is:
Each time you add a new value on either Sheet2 (Users) or Sheet3 (Clothes), you want Excel to dynamically add on Sheet1 (Summary) a new row for each value on the other Sheet (Users or Clothes depending on the one that was changed)
Btw, where does the amount come from?
Answer
Yet, to answer your question, the easiest way is to do it with VBA so it will be dynamic.
Here is what you can do:
add en event Worksheet_Change() on both Sheet2 and Sheet3 (see on Chip Pearson website how to do it)
this procedure will watch every change on these sheets. Every time a user add a value, you should loop over the other Sheet get the value from the other sheet and populate an array (Clothes or User depending on the value)
IMHO, the easiest way to consolidate the data is to create loop over your created array (or use a dictionary) and append every new row to your array
eventually, you can add the array in your Summary sheet
Don't hesitate to ask for some more information if you need or ask a new question with what you've tried if you are still stuck.
[EDIT 2] Here is a full working solution for articles (easily adaptable for users)
Code on Sheet3 (Articles)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aSum() As String
Dim sArticle As String, sPrice As Long
Dim i As Integer, iLastrow As Integer
If Intersect(Range("A:B"), Target) Is Nothing Then Exit Sub
'if no price, exit sub
If Not Intersect(Range("A:A"), Target) Is Nothing Then
If Target.Offset(0, 1).Value = Empty Then Exit Sub
sArticle = Target.Value
sPrice = CLng(Target.Offset(0, 1).Value)
End If
'if no name, exit sub
If Not Intersect(Range("B:B"), Target) Is Nothing Then
If Target.Offset(0, -1).Value = Empty Then Exit Sub
sArticle = Target.Offset(0, -1).Value
sPrice = CLng(Target.Value)
End If
'get the names in an array
collectNames
'store the data in a new array so to map these values in the end
ReDim aSum(UBound(vNames) - 1, 3)
For i = 0 To UBound(vNames) - 1
aSum(i, 0) = vNames(i + 1, 1)
aSum(i, 1) = sArticle
aSum(i, 3) = sPrice
Next
'store the data back to the Summary sheet
With ThisWorkbook.Sheets("Summary")
iLastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & iLastrow & ":D" & iLastrow + UBound(vNames) - 1).Value = aSum
End With
End Sub
Code in a module
Option Explicit
Public vNames As Variant
Public vClothes As Variant
Public Sub collectNames()
With ThisWorkbook.Sheets(2)
vNames = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
End Sub
Public Sub collectClothItems()
With ThisWorkbook.Sheets(3)
vClothes = .Range("A2", .Range("B" & Rows.Count).End(xlUp))
End With
End Sub
I didn't use dictionaries (maybe #Issun may have an idea here, he is a dict-expert) but arrays because it was easier to map to the sheet ranges.