• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Multi item add

D

delta

Member
i upload file in sheet "Bill" create a button when click on button the data will be add on sheet "Data" but my problem is consignee name, Invoice number, Invoice date will be add four time, i want to consignee name, Invoice number, Invoice date will be add only one time
this macro will be in module.


▬▬▬▬▬▬▬▬▬ Mod edit : thread moved to appropriate forum !
​
 

Attachments

  • PSC_2017.xlsm
    73.8 KB · Views: 8
Code: 
Sub ADD_DATA()

  Dim rng As Range
  Dim temp As Variant
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range, flg As Boolean  '★
  Application.ScreenUpdating = False
  i = 1
  Set rng_dest = Sheets("Data").Range("D:I")
  ' Find first empty row in columns D:G on sheet Invoice data
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
   
  Loop
  'Copy range B19:G28 on sheet Bill to Variant array
  Set rng = Sheets("Bill").Range("B19:G28")
  ' Copy rows containing values to sheet Data
  For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
   
      If Not flg Then　　'★
        'Copy Company name
     
         Sheets("Data").Range("A" & i).Value = Sheets("Bill").Range("C3").Value
         
         flg = True
      End If　　'★
   
      rng_dest.Rows(i).Value = rng.Rows(a).Value
     
      'Copy Invoice number
      Sheets("Data").Range("B" & i).Value = Sheets("Bill").Range("F5").Value
       
      'Copy Date
     
      Sheets("Data").Range("C" & i).Value = Sheets("Bill").Range("F7").Value
     
     
      ' DESPATCHED THROUGH
     
      Sheets("Data").Range("V" & i).Value = Sheets("Bill").Range("F9").Value
     
     
      ' DESPATCHED FROM
     
      Sheets("Data").Range("W" & i).Value = Sheets("Bill").Range("F11").Value
     
      ' TRANSPORT
     
      Sheets("Data").Range("T" & i).Value = Sheets("Bill").Range("F13").Value
     
      ' VAT NO
     
      Sheets("Data").Range("Y" & i).Value = Sheets("Bill").Range("B7").Value
     
      ' CST NO
     
      Sheets("Data").Range("Z" & i).Value = Sheets("Bill").Range("B9").Value
     
     
      ' P.O. NO.
     
      Sheets("Data").Range("P" & i).Value = Sheets("Bill").Range("C16").Value
     
     
      ' S.B. NO.
     
     
      Sheets("Data").Range("O" & i).Value = Sheets("Bill").Range("D16").Value
     
     
      '  FROM
     
     
      Sheets("Data").Range("AD" & i).Value = Sheets("Bill").Range("E16").Value
     
     
      ' LR NO.
     
      Sheets("Data").Range("S" & i).Value = Sheets("Bill").Range("F16").Value
     
     
      ' MAKE
     
      Sheets("Data").Range("Q" & i).Value = Sheets("Bill").Range("G16").Value
     
     
      ' ADDRESS
     
     
      Sheets("Data").Range("X" & i).Value = Sheets("Bill").Range("B4").Value
     
      ' Vat 4%
     
      Sheets("Data").Range("J" & i).Value = Sheets("Bill").Range("G30").Value
     
      ' Add. Vat 1%
     
      Sheets("Data").Range("K" & i).Value = Sheets("Bill").Range("G31").Value
     
      ' Freight
     
      Sheets("Data").Range("AA" & i).Value = Sheets("Bill").Range("G32").Value
     
           
      i = i + 1
       
    End If
   
  Next a


       
  Application.ScreenUpdating = True


End Sub
 
jindon said:
Code: 
Sub ADD_DATA()

  Dim rng As Range
  Dim temp As Variant
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range, flg As Boolean  '★
  Application.ScreenUpdating = False
  i = 1
  Set rng_dest = Sheets("Data").Range("D:I")
  ' Find first empty row in columns D:G on sheet Invoice data
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  
  Loop
  'Copy range B19:G28 on sheet Bill to Variant array
  Set rng = Sheets("Bill").Range("B19:G28")
  ' Copy rows containing values to sheet Data
  For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
  
      If Not flg Then　　'★
        'Copy Company name
    
         Sheets("Data").Range("A" & i).Value = Sheets("Bill").Range("C3").Value
        
         flg = True
      End If　　'★
  
      rng_dest.Rows(i).Value = rng.Rows(a).Value
    
      'Copy Invoice number
      Sheets("Data").Range("B" & i).Value = Sheets("Bill").Range("F5").Value
      
      'Copy Date
    
      Sheets("Data").Range("C" & i).Value = Sheets("Bill").Range("F7").Value
    
    
      ' DESPATCHED THROUGH
    
      Sheets("Data").Range("V" & i).Value = Sheets("Bill").Range("F9").Value
    
    
      ' DESPATCHED FROM
    
      Sheets("Data").Range("W" & i).Value = Sheets("Bill").Range("F11").Value
    
      ' TRANSPORT
    
      Sheets("Data").Range("T" & i).Value = Sheets("Bill").Range("F13").Value
    
      ' VAT NO
    
      Sheets("Data").Range("Y" & i).Value = Sheets("Bill").Range("B7").Value
    
      ' CST NO
    
      Sheets("Data").Range("Z" & i).Value = Sheets("Bill").Range("B9").Value
    
    
      ' P.O. NO.
    
      Sheets("Data").Range("P" & i).Value = Sheets("Bill").Range("C16").Value
    
    
      ' S.B. NO.
    
    
      Sheets("Data").Range("O" & i).Value = Sheets("Bill").Range("D16").Value
    
    
      '  FROM
    
    
      Sheets("Data").Range("AD" & i).Value = Sheets("Bill").Range("E16").Value
    
    
      ' LR NO.
    
      Sheets("Data").Range("S" & i).Value = Sheets("Bill").Range("F16").Value
    
    
      ' MAKE
    
      Sheets("Data").Range("Q" & i).Value = Sheets("Bill").Range("G16").Value
    
    
      ' ADDRESS
    
    
      Sheets("Data").Range("X" & i).Value = Sheets("Bill").Range("B4").Value
    
      ' Vat 4%
    
      Sheets("Data").Range("J" & i).Value = Sheets("Bill").Range("G30").Value
    
      ' Add. Vat 1%
    
      Sheets("Data").Range("K" & i).Value = Sheets("Bill").Range("G31").Value
    
      ' Freight
    
      Sheets("Data").Range("AA" & i).Value = Sheets("Bill").Range("G32").Value
    
          
      i = i + 1
      
    End If
  
  Next a


      
  Application.ScreenUpdating = True


End Sub
Click to expand...

perfect answer Briant
Thanks a lot
 
Code: 
Sub ADD_DATA()

  Dim rng As Range
  Dim temp As Variant
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range, flg As Boolean  '★
 Application.ScreenUpdating = False
  i = 1
  Set rng_dest = Sheets("Data").Range("D:I")
  ' Find first empty row in columns D:G on sheet Invoice data
 Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
   
  Loop
  'Copy range B19:G28 on sheet Bill to Variant array
 Set rng = Sheets("Bill").Range("B19:G28")
  ' Copy rows containing values to sheet Data
 For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
   
      If Not flg Then    '★
       'Copy Company name
   
         Sheets("Data").Range("A" & i).Value = Sheets("Bill").Range("C3").Value
      'Copy Invoice number
     Sheets("Data").Range("B" & i).Value = Sheets("Bill").Range("F5").Value
          'Copy Date
   
      Sheets("Data").Range("C" & i).Value = Sheets("Bill").Range("F7").Value
     

         
         flg = True
      End If    '★
      rng_dest.Rows(i).Value = rng.Rows(a).Value
     

           ' DESPATCHED THROUGH
   
      Sheets("Data").Range("V" & i).Value = Sheets("Bill").Range("F9").Value

      ' DESPATCHED FROM
   
      Sheets("Data").Range("W" & i).Value = Sheets("Bill").Range("F11").Value
     
      ' TRANSPORT
   
      Sheets("Data").Range("T" & i).Value = Sheets("Bill").Range("F13").Value
     
      ' VAT NO
   
      Sheets("Data").Range("Y" & i).Value = Sheets("Bill").Range("B7").Value
     
      ' CST NO
   
      Sheets("Data").Range("Z" & i).Value = Sheets("Bill").Range("B9").Value
     
     
      ' P.O. NO.
   
      Sheets("Data").Range("P" & i).Value = Sheets("Bill").Range("C16").Value
     
     
      ' S.B. NO.
   
     
      Sheets("Data").Range("O" & i).Value = Sheets("Bill").Range("D16").Value
     
     
      '  FROM
   
     
      Sheets("Data").Range("AD" & i).Value = Sheets("Bill").Range("E16").Value
     
     
      ' LR NO.
   
      Sheets("Data").Range("S" & i).Value = Sheets("Bill").Range("F16").Value
     
     
      ' MAKE
   
      Sheets("Data").Range("Q" & i).Value = Sheets("Bill").Range("G16").Value
     
     
      ' ADDRESS
   
     
      Sheets("Data").Range("X" & i).Value = Sheets("Bill").Range("B4").Value
     
      ' Vat 4%
   
      Sheets("Data").Range("J" & i).Value = Sheets("Bill").Range("G30").Value
     
      ' Add. Vat 1%
   
      Sheets("Data").Range("K" & i).Value = Sheets("Bill").Range("G31").Value
     
      ' Freight
   
      Sheets("Data").Range("AA" & i).Value = Sheets("Bill").Range("G32").Value
     
           
      i = i + 1
       
    End If
   
  Next a


       
  Application.ScreenUpdating = True


End Sub
 
You must log in or register to reply here.
Back
Top