Checking Columns and Adding For Non Existing Data

This post has been deleted.

Thank you for your understanding.

Try this

Sub SaveScore()

Dim RW As Long, rFind As Range, rComp As Range

If Worksheets("Orders").Range("C6") <> False Then
    MsgBox "Please create a new one!", vbOKOnly + vbExclamation, "Warning"
    Exit Sub
End If

If Worksheets("Orders").[D6] <> "Complete" Then
    MsgBox "Please enter all data!", vbOKOnly + vbExclamation, "Warning"
    Exit Sub
End If

Set rComp = Sheets("Companies").Range("C17").CurrentRegion
rComp.Sort Key1:=rComp(1, 1), Order1:=xlAscending, header:=xlGuess
With rComp.Columns(1)
    Set rFind = .Find(What:=Range("Company"), LookIn:=xlFormulas, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        RW = rFind.Row
    Else
        Call AddNewCustomer(Range("B7"))
        'MsgBox "Please create a new customer!", vbOKOnly + vbExclamation, "Warning"
        Exit Sub
    End If
End With

If Worksheets("Orders").[D23] = 0 Then
    MsgBox "Please enter product quantities!", vbOKOnly + vbExclamation, "Warning"
    Exit Sub
End If

With Worksheets("Companies")
    .Range("D" & RW) = Worksheets("Orders").[Name]
    .Range("I" & RW) = .Range("I" & RW) + Worksheets("Orders").[D25]
    .Range("J" & RW) = Worksheets("Orders").[Invoice]
End With


'Haven't touched section below except to tidy up a little
With Sheets("Orders")
    .Range("D34") = .Range("D34") + .Range("D17")
    .Range("F34") = .Range("F34") - .Range("D17")
    .Range("D35") = .Range("D35") + .Range("D18")
    .Range("F35") = .Range("F35") - .Range("D18")
    .Range("D36") = .Range("D36") + .Range("D19")
    .Range("F36") = .Range("F36") - .Range("D19")
    .Range("D37") = .Range("D37") + .Range("D20")
    .Range("F37") = .Range("F37") - .Range("D20")
    .Range("D38") = .Range("D38") + .Range("D21")
    .Range("F38") = .Range("F38") - .Range("D21")
End With
End Sub




Sub getShapeProc()
    'List of buttons/shapes ON THE worksheets

End Sub

Sub AddNewCustomer(NewCustomer As String)
Sheets("Companies").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = NewCustomer
Set rComp = Sheets("Companies").Range("C17").CurrentRegion
rComp.Sort Key1:=rComp(1, 1), Order1:=xlAscending, header:=xlNo
End Sub

This post has been deleted

Thank you for your understanding.

Try

Sub SaveScore()

Dim RW As Long, rFind As Range, rComp As Range

If Worksheets("Orders").Range("C6") <> False Then
    MsgBox "Please create a new one!", vbOKOnly + vbExclamation, "Warning"
    Exit Sub
End If

If Worksheets("Orders").[D6] <> "Complete" Then
    MsgBox "Please enter all data!", vbOKOnly + vbExclamation, "Warning"
    Exit Sub
End If

Set rComp = Sheets("Companies").Range("C15").CurrentRegion
If rComp.Count <> 1 Then rComp.Sort Key1:=rComp(1, 1), Order1:=xlAscending, header:=xlYes
With rComp.Columns(1)
    Set rFind = .Find(What:=Range("Company"), LookIn:=xlFormulas, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        RW = rFind.Row
    Else
        Call AddNewCustomer(Range("B7"))
        'MsgBox "Please create a new customer!", vbOKOnly + vbExclamation, "Warning"
        Exit Sub
    End If
End With

If Worksheets("Orders").[D23] = 0 Then
    MsgBox "Please enter product quantities!", vbOKOnly + vbExclamation, "Warning"
    Exit Sub
End If

With Worksheets("Companies")
    .Range("D" & RW) = Worksheets("Orders").[Name]
    .Range("I" & RW) = .Range("I" & RW) + Worksheets("Orders").[D25]
    .Range("J" & RW) = Worksheets("Orders").[Invoice]
End With


'Haven't touched section below except to tidy up a little
With Sheets("Orders")
    .Range("D34") = .Range("D34") + .Range("D17")
    .Range("F34") = .Range("F34") - .Range("D17")
    .Range("D35") = .Range("D35") + .Range("D18")
    .Range("F35") = .Range("F35") - .Range("D18")
    .Range("D36") = .Range("D36") + .Range("D19")
    .Range("F36") = .Range("F36") - .Range("D19")
    .Range("D37") = .Range("D37") + .Range("D20")
    .Range("F37") = .Range("F37") - .Range("D20")
    .Range("D38") = .Range("D38") + .Range("D21")
    .Range("F38") = .Range("F38") - .Range("D21")
End With
End Sub




Sub getShapeProc()
    'List of buttons/shapes ON THE worksheets

End Sub

Sub AddNewCustomer(NewCustomer As String)
Sheets("Companies").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = NewCustomer
Set rComp = Sheets("Companies").Range("C15").CurrentRegion
rComp.Sort Key1:=rComp(1, 1), Order1:=xlAscending, header:=xlYes
End Sub

I've removed the blank row 16 on the Customer sheet which makes things easier.

This post has been deleted.

Thank you for your understanding.

Your attachment appears to have disappeared from the thread - can you reattach?

This post has been deleted.

Thank you for your understanding.

I'm not sure how close I am to what you are after but please have a look at the attached.

A new row is created in the companies table when a novel value is added. I've also added a bit of functionality to pull in details for existing customers.

Please have a play with it and see what else needs doing.

This post has been deleted.

Thank you for your understanding.

Here it is. Sorry about that.