how to copy above cell values down

K

kamranyd

Board Regular
Joined
Apr 24, 2018
Messages
152
Office Version
  1. 2021
Platform
  1. Windows
these codes paste value at the last available row in column A, but i also want to copy above cell values which are in cell B, C, D columns down last row also?

VBA Code: 
P
rivate Sub custnameonlysave_Click()
Dim CustRow As Long
Sheets("lists").Unprotect
Range("C8").MergeArea.ClearContents
    If Me.custnameonlytextBox.Value = Empty Then
        MsgBox "Please add customer name before saving", vbCritical, "Add Customer Name"
        Exit Sub
    End If
    
    With Sheet1
         If IsEmpty(Sheet2.Range("C8").Value) Then    'New Customer
         CustRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1  'First avail Row
    End If
       .Cells(CustRow, "A").Value = Me.custnameonlytextBox.Value
       .Cells(CustRow, "A").Locked = False
    End With
        
        CustNameOnly.Hide
        Sheet2.Range("C8").Value = custnameonlytextBox.Value    'Set Customer Name
        'Sheets("lists").Protect
End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
kamranyd said:
these codes paste value at the last available row in column A, but i also want to copy above cell values which are in cell B, C, D columns down last row also?

VBA Code: 
P
rivate Sub custnameonlysave_Click()
Dim CustRow As Long
Sheets("lists").Unprotect
Range("C8").MergeArea.ClearContents
    If Me.custnameonlytextBox.Value = Empty Then
        MsgBox "Please add customer name before saving", vbCritical, "Add Customer Name"
        Exit Sub
    End If
   
    With Sheet1
         If IsEmpty(Sheet2.Range("C8").Value) Then    'New Customer
         CustRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1  'First avail Row
    End If
       .Cells(CustRow, "A").Value = Me.custnameonlytextBox.Value
       .Cells(CustRow, "A").Locked = False
    End With
       
        CustNameOnly.Hide
        Sheet2.Range("C8").Value = custnameonlytextBox.Value    'Set Customer Name
        'Sheets("lists").Protect
End Sub
Click to expand...
any help
 
Upvote 0
Not tested. Try this on a copy.
VBA Code: 
Private Sub custnameonlysave_Click()
    Dim CustRow As Long
    Dim wsLists As Worksheet
    Dim wsData As Worksheet
    
    Set wsLists = ThisWorkbook.Sheets("lists")
    Set wsData = ThisWorkbook.Sheets("Sheet1")
    
    wsLists.Unprotect
    
    wsLists.Range("C8").MergeArea.ClearContents
    
    If Me.custnameonlytextBox.Value = Empty Then
        MsgBox "Please add customer name before saving", vbCritical, "Add Customer Name"
        Exit Sub
    End If
    
    With wsData
        If IsEmpty(wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Value) Then
            CustRow = 1
        Else
            CustRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        End If
        
        .Cells(CustRow, "A").Value = Me.custnameonlytextBox.Value
        .Cells(CustRow, "A").Locked = False
        
        If CustRow > 1 Then
            .Range(.Cells(CustRow - 1, "B"), .Cells(CustRow - 1, "D")).Copy Destination:=.Range(.Cells(CustRow, "B"), .Cells(CustRow, "D"))
        End If
    End With
    
    CustNameOnly.Hide
    
    wsLists.Range("C8").Value = Me.custnameonlytextBox.Value
    
    ' wsLists.Protect
    
End Sub
 
Upvote 0
figured out how to do it, but seems codes got long, can it be shorten without any problem.

Private Sub SaveBtn_Click()

Dim CustRow As Long, CustCol As Long
Dim CustomerFld As Control

Range("C8").MergeArea.ClearContents
Range("C9").MergeArea.ClearContents

Sheets("lists").Unprotect

If Me.Field1.Value = Empty Then
MsgBox "Please add customer name before saving.", vbCritical, "Add Customer Name"
Field1.BackColor = RGB(255, 204, 204)
Field1.SetFocus
Exit Sub
Else
Field1.BackColor = RGB(191, 254, 255)
End If

If Me.Field2.Value = Empty Then
MsgBox "Please add company name before saving.", vbCritical, "Add Company Name"
Field2.BackColor = RGB(255, 204, 204)
Field2.SetFocus
Exit Sub
Else
Field2.BackColor = RGB(191, 254, 255)
End If

If Me.Field3.Value = Empty Then
MsgBox "Please add company three alphabet abbreviation before saving.", vbCritical, "Add Company Initial"
Field3.BackColor = RGB(255, 204, 204)
Field3.SetFocus
Exit Sub
Else
Field3.BackColor = RGB(191, 254, 255)
End If

If Me.Field4.Value = "" Then
Else
If Not IsNumeric(Field4.Value) Then
MsgBox "Please enter number only in VATIN.", vbCritical, "Type Numbers Only"
Field4.BackColor = RGB(255, 204, 204)
Field4.SetFocus
Exit Sub
Else
Field4.BackColor = RGB(191, 254, 255)
End If
End If

If Me.Field8.Value = "" Then
Else
If Not IsNumeric(Field8.Value) Then
MsgBox "Please enter number only in Payments Terms.", vbCritical, "Type Numbers Only"
Field8.BackColor = RGB(255, 204, 204)
Field8.SetFocus
Exit Sub
Else
Field8.BackColor = RGB(191, 254, 255)
End If
End If

With Sheet1
If IsEmpty(Sheet2.Range("C8").Value) Then
CustRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End If
.Cells(CustRow, "A").Value = Me.Field1.Value
.Cells(CustRow, "B").FillDown
.Cells(CustRow, "C").FillDown
.Cells(CustRow, "D").FillDown
.Cells(CustRow, "A").Locked = False

If IsEmpty(Sheet2.Range("C9").Value) Then
CustRow = .Cells(.Rows.Count, "K").End(xlUp).Row + 1
End If
.Cells(CustRow, "K").Value = Me.Field2.Value
.Cells(CustRow, "L").FillDown
.Cells(CustRow, "M").FillDown
.Cells(CustRow, "N").FillDown
.Cells(CustRow, "K").Locked = False

For CustCol = 14 To 20
Set CustomerFld = Me.Controls("Field" & CustCol - 12)
.Cells(CustRow, CustCol).Value = CustomerFld.Value
Next CustCol
.Cells(CustRow, "N").Locked = False
.Cells(CustRow, "O").Locked = False
.Cells(CustRow, "P").Locked = False
.Cells(CustRow, "Q").Locked = False
.Cells(CustRow, "R").Locked = False
.Cells(CustRow, "S").Locked = False

CustDetails.Hide

Sheet2.Range("C8").Value = Field1.Value
Sheet2.Range("C9").Value = Field2.Value
MsgBox "Customer is added to Client Lists Database", vbInformation, "Customer is Added to Database."
Sheets("lists").Protect
End With
End Sub
[/CODE]
 
Upvote 0
I figured out how to do it, but seems codes got long, can it be shorten without any problem.

Code: 
Private Sub SaveBtn_Click()

Dim CustRow As Long, CustCol As Long
Dim CustomerFld As Control

Range("C8").MergeArea.ClearContents
Range("C9").MergeArea.ClearContents

Sheets("lists").Unprotect

If Me.Field1.Value = Empty Then
    MsgBox "Please add customer name before saving.", vbCritical, "Add Customer Name"
    Field1.BackColor = RGB(255, 204, 204)
    Field1.SetFocus
    Exit Sub
    Else
    Field1.BackColor = RGB(191, 254, 255)
End If

If Me.Field2.Value = Empty Then
    MsgBox "Please add company name before saving.", vbCritical, "Add Company Name"
    Field2.BackColor = RGB(255, 204, 204)
    Field2.SetFocus
    Exit Sub
    Else
    Field2.BackColor = RGB(191, 254, 255)
End If

If Me.Field3.Value = Empty Then
    MsgBox "Please add company three alphabet abbreviation before saving.", vbCritical, "Add Company Initial"
    Field3.BackColor = RGB(255, 204, 204)
    Field3.SetFocus
    Exit Sub
    Else
    Field3.BackColor = RGB(191, 254, 255)
End If

If Me.Field4.Value = "" Then
Else
If Not IsNumeric(Field4.Value) Then
    MsgBox "Please enter number only in VATIN.", vbCritical, "Type Numbers Only"
    Field4.BackColor = RGB(255, 204, 204)
    Field4.SetFocus
    Exit Sub
    Else
    Field4.BackColor = RGB(191, 254, 255)
End If
End If

If Me.Field8.Value = "" Then
Else
If Not IsNumeric(Field8.Value) Then
    MsgBox "Please enter number only in Payments Terms.", vbCritical, "Type Numbers Only"
    Field8.BackColor = RGB(255, 204, 204)
    Field8.SetFocus
    Exit Sub
    Else
    Field8.BackColor = RGB(191, 254, 255)
End If
End If
    
With Sheet1
         If IsEmpty(Sheet2.Range("C8").Value) Then
         CustRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End If
       .Cells(CustRow, "A").Value = Me.Field1.Value
       .Cells(CustRow, "B").FillDown
       .Cells(CustRow, "C").FillDown
       .Cells(CustRow, "D").FillDown
       .Cells(CustRow, "A").Locked = False
      
        If IsEmpty(Sheet2.Range("C9").Value) Then
         CustRow = .Cells(.Rows.Count, "K").End(xlUp).Row + 1
    End If
       .Cells(CustRow, "K").Value = Me.Field2.Value
       .Cells(CustRow, "L").FillDown
       .Cells(CustRow, "M").FillDown
       .Cells(CustRow, "N").FillDown
       .Cells(CustRow, "K").Locked = False
        
    For CustCol = 14 To 20
        Set CustomerFld = Me.Controls("Field" & CustCol - 12)
            .Cells(CustRow, CustCol).Value = CustomerFld.Value
    Next CustCol
    .Cells(CustRow, "N").Locked = False
    .Cells(CustRow, "O").Locked = False
    .Cells(CustRow, "P").Locked = False
    .Cells(CustRow, "Q").Locked = False
    .Cells(CustRow, "R").Locked = False
    .Cells(CustRow, "S").Locked = False
    
    CustDetails.Hide
    
    Sheet2.Range("C8").Value = Field1.Value
    Sheet2.Range("C9").Value = Field2.Value
    MsgBox "Customer is added to Client Lists Database", vbInformation, "Customer is Added to Database."
    'Sheets("lists").Protect
End With
End Sub
 
Upvote 0
kamranyd said:
I figured out how to do it, but seems codes got long, can it be shorten without any problem.

Code: 
Private Sub SaveBtn_Click()

Dim CustRow As Long, CustCol As Long
Dim CustomerFld As Control

Range("C8").MergeArea.ClearContents
Range("C9").MergeArea.ClearContents

Sheets("lists").Unprotect

If Me.Field1.Value = Empty Then
    MsgBox "Please add customer name before saving.", vbCritical, "Add Customer Name"
    Field1.BackColor = RGB(255, 204, 204)
    Field1.SetFocus
    Exit Sub
    Else
    Field1.BackColor = RGB(191, 254, 255)
End If

If Me.Field2.Value = Empty Then
    MsgBox "Please add company name before saving.", vbCritical, "Add Company Name"
    Field2.BackColor = RGB(255, 204, 204)
    Field2.SetFocus
    Exit Sub
    Else
    Field2.BackColor = RGB(191, 254, 255)
End If

If Me.Field3.Value = Empty Then
    MsgBox "Please add company three alphabet abbreviation before saving.", vbCritical, "Add Company Initial"
    Field3.BackColor = RGB(255, 204, 204)
    Field3.SetFocus
    Exit Sub
    Else
    Field3.BackColor = RGB(191, 254, 255)
End If

If Me.Field4.Value = "" Then
Else
If Not IsNumeric(Field4.Value) Then
    MsgBox "Please enter number only in VATIN.", vbCritical, "Type Numbers Only"
    Field4.BackColor = RGB(255, 204, 204)
    Field4.SetFocus
    Exit Sub
    Else
    Field4.BackColor = RGB(191, 254, 255)
End If
End If

If Me.Field8.Value = "" Then
Else
If Not IsNumeric(Field8.Value) Then
    MsgBox "Please enter number only in Payments Terms.", vbCritical, "Type Numbers Only"
    Field8.BackColor = RGB(255, 204, 204)
    Field8.SetFocus
    Exit Sub
    Else
    Field8.BackColor = RGB(191, 254, 255)
End If
End If
   
With Sheet1
         If IsEmpty(Sheet2.Range("C8").Value) Then
         CustRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End If
       .Cells(CustRow, "A").Value = Me.Field1.Value
       .Cells(CustRow, "B").FillDown
       .Cells(CustRow, "C").FillDown
       .Cells(CustRow, "D").FillDown
       .Cells(CustRow, "A").Locked = False
     
        If IsEmpty(Sheet2.Range("C9").Value) Then
         CustRow = .Cells(.Rows.Count, "K").End(xlUp).Row + 1
    End If
       .Cells(CustRow, "K").Value = Me.Field2.Value
       .Cells(CustRow, "L").FillDown
       .Cells(CustRow, "M").FillDown
       .Cells(CustRow, "N").FillDown
       .Cells(CustRow, "K").Locked = False
       
    For CustCol = 14 To 20
        Set CustomerFld = Me.Controls("Field" & CustCol - 12)
            .Cells(CustRow, CustCol).Value = CustomerFld.Value
    Next CustCol
    .Cells(CustRow, "N").Locked = False
    .Cells(CustRow, "O").Locked = False
    .Cells(CustRow, "P").Locked = False
    .Cells(CustRow, "Q").Locked = False
    .Cells(CustRow, "R").Locked = False
    .Cells(CustRow, "S").Locked = False
   
    CustDetails.Hide
   
    Sheet2.Range("C8").Value = Field1.Value
    Sheet2.Range("C9").Value = Field2.Value
    MsgBox "Customer is added to Client Lists Database", vbInformation, "Customer is Added to Database."
    'Sheets("lists").Protect
End With
End Sub
Click to expand...
any help will be appreciated
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
vba code for unlocking cell after paste
Replies
1
Views
70
MikeVol
MikeVol
K
  • Question
User form for customer entry
Replies
2
Views
76
kamranyd
K
F
  • Question
VBA run code based off cell value
Replies
1
Views
390
igold
igold
F
  • Question
VBA code giving error on line .Wrap = wdFindContinue
Replies
2
Views
462
NdNoviceHlp
NdNoviceHlp
S
  • Solved
Miscrosoft has Blocking The Macro Sometimes and disabling the macros
Replies
5
Views
450
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,216,085
Messages
6,128,733
Members
449,465
Latest member
TAKLAM

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top