I have a shared spreadsheet that has both a form for users to enter data into and a log for the data to be moved to once the user hits the "submit" button (calls the Submit_to_Log sub). The macro works well in an unshared file; the only issue is when I share the file and two or more users try to submit data at the same time, the macro tries to write both of their data to the same, next blank row. The user who submits the data first gets their data submitted successfully, but the second user encounters an error where their data isn't submitted to the log but is still deleted from the form. Sheet3 refers to the log and sheet1 refers to the form. Any tips on how to improve this code?
Sub Submit_to_Log()
On Error GoTo ErrorHandler
Dim rng_form As Range
erow = Sheet3.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
Set rng_form = Sheet1.Range("B3:S" & Range("K2").End(xlDown).Row)
If IsEmpty(Sheet1.Range("K3").Value) Then
MsgBox "First row must be filled!" & vbNewLine & vbNewLine & "If the first row is filled, please make sure that column K is filled out."
End
End If
rng_form.Copy
Sheet3.Range("B" & erow).PasteSpecial xlPasteValues
Sheet3.Activate
Sheet3.Range("A1").Select
Sheet1.Activate
rng_form.EntireRow.Delete
MsgBox "Your requests have been submitted." & vbNewLine & vbNewLine & "If you still see requests in the form waiting to be submitted, please make sure that there are no empty rows between your requests and/or that each request has column K filled out."
Exit Sub
ErrorHandler:
MsgBox "There was an error. Please try again."
End Sub
Related
I am trying to make a row in my Excel table mandatory before users close the document, then display a pop-up message stating "cells require input".
I am running into an issue where users are still getting the pop-up message even if they have filled out all the mandatory cells.
This is a screenshot of what all I typed out. I have this in the workbook area
I am typing what's in the screenshot, in the workbook area, and have it to run beforeclose.
This is the what I used below. My required fields is the row A3-O3
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Value = "" Then
MsgBox "Cell(s) require input", vbInformation, "Kutools for Excel"
Cancel = True
End If
End Sub
view of my spreadsheet
A plus would be a pop-up message letting the user know which cells are empty & for it to highlight the cells that are empty also
Use WorksheetFunction.CountBlank:
If Worksheetfunction.CountBlank(ActiveSheet.Range("A3:O3")) > 0 Then
MsgBox "Cell(s) require input", vbInformation
End If
Or SpecialCells(xlCellTypeBlanks):
On Error Resume Next
Dim rng As Range
Set rng = ActiveSheet.Range("A3:O3").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
MsgBox "Cell(s) " & rng.Address(False, False) & " require input", vbInformation
End If
Note that Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15) does not refer to A3:O3.
In the Immediate Window, put:
? Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Address
The result is
$DB$31
I have a template that is being used to look up a list of accounts. Its kind of like a workflow tool, where tab 1 shows a list of active accounts. Tab 2 is where data formatting takes place and tab 3 is where the completed accounts are listed. This is being used by multiple people. So as they work through the list I wanted to apply some error handling that applies a vlookup to the account the user has selected just to see if its already in the completed tab by another user.
So essentially I really want it to Vlookup against the completed list. If a match then msgbox to say "This account has already been completed", else carry on formatting the data.
The code I was trying to use was:
Set WsInput = Sheets("Account Search")
Set PolLookup = WsInput.Range("U3")
Set PolRange = Sheets("Completed Accounts").Range("B5:B15000")
With WsInput
.Range("U3").Value = Application.VLookup(PolLookup, PolRange, 1, False)
If IsError(.Range("U3").Value) Then
*Format Data
Else
MsgBox "This account has already been completed", vbExclamation
Sheets("Completed Accounts").Select
Exit Sub
End If
End With
However I can't seem to get it to work. If I put a matching account number in it goes to the msgbox, which is what I want, but if I put a new number in, it also goes to the msgbox?
Any help or advice would be much appreciated.
Thanks
Sub Check()
Dim sPol As String, rngPol As Range
sPol = Sheets("Account Search").Range("U3").Value
Set rngPol = Sheets("Completed Accounts").Range("B5:B15000")
If IsError(Application.VLookup(sPol, rngPol, 1, False)) Then
' do something
MsgBox sPol & " not completed"
Else
MsgBox "Account " & sPol & " has already been completed", vbExclamation
Sheets("Completed Accounts").Select
Exit Sub
End If
End Sub
I have a form that I have created in Excel as an input area for Production Information. Once the data has been filled into the Form I have a save button with a macro behind it. This to copy and paste the data from the form into a line in the Info Log area below the form.
I have tried to use a "helper" column to place True if the information being saved has already been saved once. I am not sure I have all of that correct either.
Sub Record_Save()
'With Sheets("Roll Line Form")
'Application.ScreenUpdating = False
'Range("B43:B" & Cells(Rows.Count, 1).End(xlUp).Row) =
"=CountIf(D2:D4,D2,)>1"
'Range("B:B").AutoFilter 1, "True"
'If .Range("B:B").Value = "True" Then
'MsgBox "This has already been entered"
'Exit Sub
'End If
'End With
With Sheets("Roll Line Form")
If .Range("D2").Value = Empty Then
MsgBox "Please Enter a Date"
Exit Sub
End If
RecordRow = .Range("C999999").End(xlUp).Row + 1 'Find First Available Row
For RecordCol = 3 To 46
.Cells(RecordRow, RecordCol).Value = .Range(.Cells(41,
RecordCol).Value).Value
Next RecordCol
End With
End Sub
I want to have the Macro understand that the data is already saved and not to save the data in the Log area. I have commented out the code I tried to use but when it was still running I would get the error code of Run-time error '1004': Application-defined or object error
This is on the line that starts Range ("B43:B"...
I have been dealing with a huge problem for a couple of weeks now and I cant fix it no matter what. Whatever I do, it works for a while until something new pop.
Objective: in a specific column of a table, allow users to type down an integer and depending on that amount insert x rows in the table (all of them being exact copies of the original row)
I have the code below I got from another site and modified it:
I got a WorksheetChange event that triggers a macro in another module.
The code below works only in non filtered tables, but once the user filters a table and the macro runs it doesnt work. The rows are inserted and are visible on whatever filter the user has, but the copy from the original row does not. I get no error, is just that the rows are inserted empty.
How can I insert whatever amount of rows the user specified in a filtered table (without taking out the filters) and copy/paste everything form the original row?
Sub InsertRows(ByVal splitVal As Integer, ByVal keyCells As Range, ws As Worksheet)
On Error GoTo ErrorHandler
PW
ws.Unprotect Password
ws.DisplayPageBreaks = False
With keyCells
.Offset(1).Resize(splitVal).EntireRow.Insert
.EntireRow.Copy .Offset(1, 0).Resize(splitVal).EntireRow
End With
ExitHandler:
ws.Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
Exit Sub
ErrorHandler:
WBNorm
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Insert_Rows, line " & Erl & "."
GoTo ExitHandler
End Sub
Have you tried doing something along the lines of:
Turn off screen updates
remove the filter
add the rows
re-enable the filter
There is an answered question on how you can save filter criteria and reapply them later on: In Excel VBA, how do I save / restore a user-defined filter?
I'm attempting to write hyperlinks to cells via one button click from the ribbon in Excel 2007. These hyperlinks must, in turn, execute another routine that does stuff to the row on which they're located. However, the standard method of Worksheet_FollowHyperlink() will not work, as I need to execute this via an external xlam addin, and as far as I understand, this event triggers from hyperlink clicks located only in the same worksheet.
As a result, I have found that using the =HYPERLINK("#funName()","Click me") method works, but a problem exists that I am still experiencing.
The following is a trimmed down version of my already-working code:
Sub InsertLink() ' This is run directly by the callback for an IRibbonControl button click
With Sheet1
lastrow = Range("A" & Rows.count).End(xlUp).Row
While i <= lastrow
Range("E" & i).Value = "=HYPERLINK(""#consolidateDuplicate(A" & i & ",C" & i & ")"",""Copy this row to next"")"
Wend
Call MsgBox ("Finished inserting hyperlinks on each row.", vbOKOnly)
End With
End Sub
Sub consolidateDuplicate(PN, Quantity)
Dim thisRow, prevQuant As Long
thisRow = Selection.Row
MsgBox("You clicked the hyperlink for " & thisRow & "Q: " & Quantity & ", PN: " & PN)
End Sub
Clicking the ribbon button successfully writes all hyperlinks into their respective rows as expected. However, when I try to click any of these hyperlinks, thus executing consolidateDuplicate() in the same add-in module, I immediately receive a "Reference is not valid" warning followed by the MsgBox message.
I have tried removing all code from the routine to no avail. I also tried the standard brute-force bypass method of adding On Error Resume Next ... On Error Goto 0 as well as Application.DisplayAlerts = False ... Application.DisplayAlerts = True. Neither helps. I still receive the warning.
So while my script works fine and does what I want it to in the end, I feel like there should be a way to suppress the warning, or fix whatever is causing it, which I have a feeling, like Worksheet_FollowHyperlink(), is from storing the routine in the scope of an add-in module (required for my application), rather than keeping it totally contained in the calling workbook/sheet itself.
Any ideas?
Your consolidateDuplicate subroutine should be a Function, returning the address that the hyperlink should take you to. The lack of a return value is what is causing the "Reference is not valid" error.
The following code might work, effectively telling the hyperlink to take you to the cell in which the hyperlink was located:
Function consolidateDuplicate(PN, Quantity) As Range
Dim thisRow, prevQuant As Long
thisRow = Selection.Row
MsgBox ("You clicked the hyperlink for " & thisRow & "Q: " & Quantity & ", PN: " & PN)
Set consolidateDuplicate = Selection
End Function