Solved: Adding form data to two sheets

[Aussiebear]

In the attached workbook, consisting of two sheets "Risk Levels" & "Test History", I record the latest residue results. Due to an operational requirement, I now need the VendorInfo form to record the new vendor data to both sheets. Access to this form is gained by clicking the Vendor Info button on the "Risk Levels" sheet.

But there's a catch.... ( isn't there always you say). Whilst the I require all of the forms data to be inserted into the "Risk Levels" sheet, I only require the Vendor's Name and Grower ID to be placed into the Test History sheet.

Note: The vendor's Name needs to be inserted in alphabetical order. Password to code is "Shona"

The original code was as follows:
Private Sub cmdAdd_Click()
Dim c As Range, cel As Range
'Save Form contents before changing rows:
Set c = Columns(1).Find(txtVendorName)
If c Is Nothing Then
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If cel > txtVendorName Then
cel.Resize(2, 13).Insert
cel.Resize(2, 13).Copy
cel.Offset(-2).PasteSpecial xlPasteFormats
ActiveWindow.ScrollRow = cel.Offset(-2).Row
Application.CutCopyMode = False
Exit For
End If
Next

'clear the form for user to add new vendor:
cel.Offset(-2).Select
SaveRow ActiveCell
End If
cmdAdd.Visible = False
txtVendorName.SetFocus
End Sub

So in desperation I thought.... I'd just double up some of the code, and place them into new sub's and then just call them.

Private Sub cmdAdd_Click()
Dim c As Range, cel As Range
'Save Form contents before changing rows:
'Add Vendor details to Risk Levels Sheet
Call AddToRiskLevels
'Add Vendor Name & VendorID to Test History Sheet
Call AddToTestHistory

'clear the form for user to add new vendor:
cel.Offset(-2).Select
SaveRow ActiveCell

cmdAdd.Visible = False
txtVendorName.SetFocus
End Sub

Private Sub AddToRiskLevels()
Dim c As Range, cel As Range
With RiskLevels
Set c = Columns(1).Find(txtVendorName)
If c Is Nothing Then
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If cel > txtVendorName Then
cel.Resize(2, 13).Insert
cel.Resize(2, 13).Copy
cel.Offset(-2).PasteSpecial xlPasteFormats
ActiveWindow.ScrollRow = cel.Offset(-2).Row
Application.CutCopyMode = False
Exit For
End If
Next
End If
End With

End Sub
Private Sub AddToTestHistory()
Dim c As Range, cel As Range
Dim Grower As String
Dim GrowerID As String
With RiskLevels
Set c = Columns(1).Find(txtVendorName)
If c Is Nothing Then
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If cel > txtVendorName Then
cel.Resize(2, 2).Insert
cel.Resize(2, 2).Copy
cel.Offset(-2).PasteSpecial xlPasteFormats
ActiveWindow.ScrollRow = cel.Offset(-2).Row
Application.CutCopyMode = False
Exit For
End If
Next
End If
End With
End Sub

and the end result is...I've stuffed it up big time.

[tstav]

Hi Ted,
check the added "." dot notation and the With Worksheets("Sheet name") I have added.
As for the 'Activewindow.ScrollRow' the window has not been activated prior to the scroll. You choose which window that will be, I have added it to both subs.
In the Test History Sheet wouldn't you need to shift down the whole row instead of the first two columns? What happens to the rest of data (columns C,D,etc.)? Don't they get shifted down too?
I haven't tested any of my code though...
Forgive any possible misunderstandings on my part...
Private Sub AddToRiskLevels()
Dim c As Range, cel As Range
With Worksheets("Risk Levels") '<--
Set c = .Columns(1).Find(txtVendorName)
If c Is Nothing Then
For Each cel In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
If cel > txtVendorName Then
cel.Resize(2, 13).Insert '<--Maybe this should be 14. I see a check sign in col 14
cel.Resize(2, 13).Copy '<-- same here
cel.Offset(-2).PasteSpecial xlPasteFormats
.Activate
ActiveWindow.ScrollRow = cel.Offset(-2).Row
Application.CutCopyMode = False
Exit For
End If
Next
End If
End With

End Sub

Private Sub AddToTestHistory()
Dim c As Range, cel As Range
Dim Grower As String
Dim GrowerID As String
With Worksheets("Test History")
Set c = .Columns(1).Find(txtVendorName)
If c Is Nothing Then
For Each cel In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
If cel > txtVendorName Then
cel.Resize(2, 2).Insert
cel.Resize(2, 2).Copy
cel.Offset(-2).PasteSpecial xlPasteFormats
.Activate
ActiveWindow.ScrollRow = cel.Offset(-2).Row
Application.CutCopyMode = False
Exit For
End If
Next
End If
End With
End Sub

[rory]

Here's my version - replace your three subs with this:
Private Sub cmdAdd_Click()
Dim c As Range, cel As Range
'Save Form contents before changing rows:
'Add Vendor details to Risk Levels Sheet
Set cel = GetNewRow(RiskLevels)
If Not cel Is Nothing Then
Call SaveRow(cel)
Set cel = Nothing
End If
'Add Vendor Name & VendorID to Test History Sheet
Set cel = GetNewRow(TestHistory)
If Not cel Is Nothing Then
Call SaveRow(cel, False)
Set cel = Nothing
End If

'clear the form for user to add new vendor:
cmdAdd.Visible = False
txtVendorName.SetFocus
End Sub
Private Function GetNewRow(wks As Worksheet) As Range
Dim c As Range, cel As Range, varRow
With wks
Set c = .Columns(1).Find(txtVendorName)
If c Is Nothing Then
' data is sorted so just match on last value less than search name
varRow = Application.Match(txtVendorName, .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)), 1)
If IsError(varRow) Then
varRow = 2
Else
varRow = varRow + 3
End If
Set cel = .Cells(varRow, "A")
cel.Resize(2).EntireRow.Insert
cel.Resize(2).EntireRow.Copy
cel.Offset(-2).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Set GetNewRow = cel.Offset(-2)
End If
End With
End Function


and change your SaveRow function to this:
Private Sub SaveRow(c As Range, Optional blnSaveAll As Boolean = True)
With c
.Offset(, 0) = txtVendorName.Text
.Offset(, 1) = txtGrowerID.Text
If blnSaveAll Then
.Offset(, 2) = txtProperty.Text
.Offset(, 3) = txtAddress.Text
.Offset(, 4) = txtTown.Text
.Offset(, 5) = txtPostCode.Text
.Offset(, 6) = txtContact.Text
.Offset(, 7) = txtVendorType.Text
.Offset(, 8) = txtInitialRisk.Text
.Offset(, 12) = txtCurrentRisk.Text
End If
End With
End Sub

[Aussiebear]

Thank you guys.