Assistance required

[Coza]

The below code i am using to try to update values that are input into a
form.

My object is to ONLY insert a NEW ROW if there is NO matching values already
in the sheet(sheet2-"Data")

If there is NO matching values then a New Row is inserted and the values
from the form are placed into row "A"

If not then they are placed into the ROW that the values DO match.

Matching values are located in Column A & B & C.

Sheet2 = "Data"

Column A = Name
Column B = Month
Column C = Year

Userform1

Combobox2 = name
Combobox1 = Month
Spinbutton1(Textbox2) = year


If a user selects a NAME(combobox2) and Month(Combobox1) and
year(Spinbutton1) and these VALUES are located in the same ROW already in
the 'Data" Sheet(Sheet2) then ANY values that are placed in the numerous
Textboxes on the form are placed into the matching ROW in Sheet2.

If there is NO matches from ALL 3 selections(Combobox2; Combobox1 &
Spinbutton1) then a NEW ROW is inserted into Sheet2 and all values entered
into the Userform are placed into the NEW ROW.

Note: There maybe and will be Matching names(Column 1) and Matching
Months(Column 2) in sheet2 but that have a different Year(Column 3), so as
there is NOT 3 Matches then a NEW Row is needed to tbe inserted.

A new row is ONLY required IF ALL 3 (Combobox2, Combobox1 & Spinbutton1)
match values in Sheet2(Column1,2 & 3).

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CODE ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub CommandButton1_Click()' Button on form
Dim rngFound As Range
On Error Resume Next
With Worksheets("Data").Range("A:A") ' Sheet2
Set rngFound = .Find(What:=Me.ComboBox2.Value, After:=.Cells(1),
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False, Matchbyte:=False)
If rngFound.Value <> "" Then
If ComboBox2.Value = rngFound.Value Then ' Name selected
If ComboBox1.Value = rngFound.Offset(0, 1).Value Then ' Month Selected
If SpinButton1.Value = rngFound.Offset(0, 2).Value Then ' Year Selected
' Input the data to the Data Sheet WITHOUT inserting a NEW ROW, into
the MATCHING Values ROW
With Sheets("Data") ' Sheet2
..Select
rngFound.Offset(0, 3) = TextBox27.Value
rngFound.Offset(0, 4) = TextBox39.Value
rngFound.Offset(0, 5) = TextBox51.Value
rngFound.Offset(0, 6) = TextBox63.Value
rngFound.Offset(0, 7) = TextBox75.Value
rngFound.Offset(0, 8) = TextBox87.Value
rngFound.Offset(0, 9) = TextBox88.Value
End With
End If
End If
End If
Unload Me
Else
Sheets("Data").Select ' Sheet2
Rows("1:1").Select
Selection.Insert Shift:=xlDown ' INSERT NEW ROW as NO Values MATCHING
are found
Range("A1").Select
With UserForm1
Sheets("Data").Select ' Sheet2
Range("A1").Value = ComboBox2.Value ' Place these values into the NEW ROW
Range("B1").Value = ComboBox1.Value ' Place these values into the NEW ROW
Range("C1").Value = TextBox2.Value ' Place these values into the NEW ROW
Range("D1").Value = TextBox27.Value ' Place these values into the NEW ROW
Range("E1").Value = TextBox39.Value ' Place these values into the NEW ROW
Range("F1").Value = TextBox51.Value ' Place these values into the NEW ROW
Range("G1").Value = TextBox63.Value ' Place these values into the NEW ROW
Range("H1").Value = TextBox75.Value ' Place these values into the NEW ROW
Range("I1").Value = TextBox87.Value ' Place these values into the NEW ROW
Range("J1").Value = TextBox88.Value ' Place these values into the NEW ROW
End With
Unload Me
End If
End With
Sheet1.Select
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Can anyone assist with this code ?
The above code does NOT seem to work as expected and explained above.


Corey....


I choose Polesoft Lockspam to fight spam, and you?
http://www.polesoft.com/refer.html

 

[Joel]

Private Sub CommandButton1_Click() ' Button on form
Dim rngFound As Range
On Error Resume Next
With Worksheets("Data").Range("A:A") ' Sheet2
Set rngFound = .Find(What:=Me.ComboBox2.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, Matchbyte:=False)

If rngFound.Value <> "" Then
If ComboBox2.Value = _
rngFound.Value Then ' Name selected

If ComboBox1.Value = _
rngFound.Offset(0, 1).Value Then ' Month Selected

If SpinButton1.Value = _
rngFound.Offset(0, 2).Value Then
' Year Selected
' Input the data to the Data Sheet
' WITHOUT inserting a NEW ROW, into
' the MATCHING Values ROW

With Sheets("Data") ' Sheet2..Select
lastrow = .Cells(Rows.Count, "A"). _
End(xlUp).Row + 1

rngFound.Offset(lastrow, 3) = _
TextBox27.Value
rngFound.Offset(lastrow, 4) = _
TextBox39.Value
rngFound.Offset(lastrow, 5) = _
TextBox51.Value
rngFound.Offset(lastrow, 6) = _
TextBox63.Value
rngFound.Offset(lastrow, 7) = _
TextBox75.Value
rngFound.Offset(lastrow, 8) = _
TextBox87.Value
rngFound.Offset(lastrow, 9) = _
TextBox88.Value
End With
End If
End If
End If
End If
End With

End Sub

 

[ssGuru]

Private Sub CommandButton1_Click() ' Button on form
Dim rngFound As Range
On Error Resume Next
With Worksheets("Data").Range("A:A") ' Sheet2
Set rngFound = .Find(What:=Me.ComboBox2.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, Matchbyte:=False)

If rngFound.Value <> "" Then
If ComboBox2.Value = _
rngFound.Value Then ' Name selected

If ComboBox1.Value = _
rngFound.Offset(0, 1).Value Then ' Month Selected

If SpinButton1.Value = _
rngFound.Offset(0, 2).Value Then
' Year Selected
' Input the data to the Data Sheet
' WITHOUT inserting a NEW ROW, into
' the MATCHING Values ROW

With Sheets("Data") ' Sheet2..Select
lastrow = .Cells(Rows.Count, "A"). _
End(xlUp).Row + 1

rngFound.Offset(lastrow, 3) = _
TextBox27.Value
rngFound.Offset(lastrow, 4) = _
TextBox39.Value
rngFound.Offset(lastrow, 5) = _
TextBox51.Value
rngFound.Offset(lastrow, 6) = _
TextBox63.Value
rngFound.Offset(lastrow, 7) = _
TextBox75.Value
rngFound.Offset(lastrow, 8) = _
TextBox87.Value
rngFound.Offset(lastrow, 9) = _
TextBox88.Value
End With
End If
End If
End If
End If
End With

End Sub

















- Show quoted text -

I have code that compares individual records in two separate sheets.
A master and an update.
If same data exists in 3 defined columns of any record(you can change
code to any number of columns) then this is an existing Master record
and the Master is just updated by any field in the update record with
a change.
If same data does not exist in the 3 columns then this is a NEW record
and entire record is copied to the end of the Master. No records are
deleted in the Master
Not sure if this is what you are looking for but will post if it is.

Dennis

 

[Coza]

Dennis,
From what you described it is exactly the same.
Can you post the code for me to try?
Thanx

Corey....

 

[ssGuru]

Dennis,
From what you described it is exactly the same.
Can you post the code for me to try?
Thanx

Corey....








- Show quoted text -

OK Coza here it is. This works quite well IF the files are in the
correct folders. I'm using some Named cells to hold file paths and
such.

It compares a sheet named "CombinedForecasts.xls" with all the same
columns as a sheed in your Master named "DDProspects" and it does not
have a header. If you have a header just changes the starting point
one row. Change filenames and paths to meet your setup.

' Combined Forecasts.xls MUST be placed in the folder path
shown
' Adds NEW records to MasterForecast DDProspects worksheet if no
match exists between
' CombinedReports and MasterForecast DDProspects based on PipeDate,
Prospect and Partner values.
' Will also create a new MasterForecast DDprospects worksheet record
due to any manual
' change to these 3 static field values in either MasterForecast or
PartnerForecast
' DDProspects worksheets.
'
' Updates existing records in MasterForecast DDProspects worksheet
IF any changes to
' the PartnerForecast DDProspects worksheet fields.
' Code DOES NOT delete records from MasterForecast DDProspects if
records no longer are
' reported in the pipeline after they have been reported by a
Partner once.
'
Sub UpdateMasterFiles()

Dim a As Long, b As Long, Found As Long
Dim lngData As Long, lngMain As Long
Dim wb As String, ws As String, mf As String
Dim rptpath As String, mstr As String

wb = "CombinedForecasts.xls"
ws = "CombinedReports"
mf = Range("MasterForecastFileName").Value

mstr = Range("PathToForecastFile").Value
'Test for "\" in path value and add if it isn't
If Right(mstr, 1) <> "\" Then
mstr = mstr & "\"
End If

rptpath = Range("PathToCombinedReports").Value
'Test for "\" in path value and add if it isn't
If Right(Range("PathToCombinedReports").Value, 1) <> "\" Then
rptpath = Range("PathToCombinedReports").Value & "\"
End If


'Check if MasterForecast file is in designated path
If Dir(mstr & mf) = "" Then
MsgBox "MasterForecast v??????.xls file is NOT in path shown in the
" & Chr(10) & _
"MasterForecastFileName Path on your InstructionPrice
worksheet " & Chr(10) & _
Chr(10) & _
"Change file or path name or move to path shown in your
InstructionPrice worksheet"
'DD exit code since MasterForecast v??????.xls is not in place

Exit Sub
End If

If Dir(rptpath & wb) = "" Then
MsgBox "CombinedForecasts.xls file is NOT in path shown in the " &
Chr(10) & _
"CombinedReports Path on your InstructionPrice worksheet "
& Chr(10) & _
Chr(10) & _
"Move file to location or change path in your
InstructionPrice worksheet"
'DD exit code since CombinedForecasts.xls is not in place

Exit Sub
End If
'MsgBox mstr & mf
'Else

' DD CombinedForecasts.xls exits so open, activate Master and run the
code
Workbooks.Open Filename:=rptpath & wb
Workbooks(mf).Worksheets("DDProspects").Activate

'First define ALL fields as Variant, Paste "" if Nulls in
CombinedReports
Dim varBlank(1 To 35) As Variant

For a = 1 To 35
varBlank(a) = ""
'Then set col = 0 just for those numeric columns you need a "0"
inserted rather than ""
Next
varBlank(8) = 0
varBlank(9) = 0
varBlank(10) = 0
varBlank(11) = 0
varBlank(12) = 0
varBlank(13) = 0
varBlank(14) = 0

'Set the pointer for the CombinedForecasts workbook to the first row
lngData = 1

'Do until the pointer in CombinedForcasts is pointing to an empty cell
Do Until Workbooks(wb).Worksheets(ws).Cells(lngData, 1) = Empty

'Set the Found flag before starting through the MasterForecasts
Worksheet
Found = 0
'Set the pointer to your MasterForecasts form to one row below the
headers
lngMain = 2

'This is where the Do Loop starts working through the
MasterForecasts worksheet
'using the row pointed to in the CombineReports worksheet
'Compare each row in the MasterForecasts worksheet with the row in
the CombinedReports worksheet
Do Until Cells(lngMain, 1) = Empty

'If the search criteria in the CombinedReports worksheet
matches the search criteria
' in the MasterForecasts worksheet
'Check the static columns used to define a unique record.
PipeDate, Prospect, Partner.
If Workbooks(wb).Worksheets(ws) _
.Cells(lngData, 1) = Cells(lngMain, 1) And _
Workbooks(wb).Worksheets(ws) _
.Cells(lngData, 3) = Cells(lngMain, 3) And _
Workbooks(wb).Worksheets(ws) _
.Cells(lngData, 26) = Cells(lngMain, 26) Then

'Set the Found flag to 1 because you found a match in both
worksheets
Found = 1
'Check for differences between the records
b = 0

'This compares the two rows for differences in any col
except 1,3,26 defined above
For a = 1 To 28

'IF need code to skip a column then add the col index
'If a = 3 Then
'b = 0
'End If

'Check for changes. If the cells do not match then
If Workbooks(wb).Worksheets(ws) _
.Cells(lngData, a) <> Cells(lngMain, a + b) Then

'If the cell in the CombinedReports worksheet is
empty then
If Workbooks(wb).Worksheets(ws) _
.Cells(lngData, a) = Empty Then
Cells(lngMain, a + b) = varBlank(a + b)

'Otherwise put the data from the CombinedReports
worksheet
' into the MasterForecasts workbook
Else

Cells(lngMain, a + b) = _
Workbooks(wb).Worksheets(ws) _
.Cells(lngData, a)
End If
End If
Next
End If

'Move the pointer to the next row in MasterForecasts worksheet
lngMain = lngMain + 1
Loop

'Judge if it is a new row. If a match was found the variable
' Found would have been set to 1

'If no match was found going through the MasterForecasts
worksheet,
' then must be new record, add it to the bottom of the
MasterForecasts worksheet
If Found = 0 Then
b = 0
For a = 1 To 28

'IF need code to skip a column then add the col index
'If a = 3 Then
'b = 0
'End If

If Workbooks(wb).Worksheets(ws).Cells(lngData, a) _
= Empty Then
Cells(lngMain, a + b) = varBlank(a + b)
Else
Cells(lngMain, a + b) = _
Workbooks(wb).Worksheets(ws).Cells(lngData, a)
End If
Next
End If

'Move pointer to the next row in CombinedReports workbook and
start comparing it to all the
' rows in the MasterForecasts worksheet. Loop until empty record.

lngData = lngData + 1
Loop

'Close the external workbook CombinedReports
Workbooks(wb).Close
'Save the Master to update the calculations
ActiveWorkbook.Save

End Sub