Transferring data from one sheet to another

Solved/Closed

cuffy70

Posts: 6
Registration date: Tuesday January 22, 2013
Status: Member
Last seen: January 29, 2013

- Jan 22, 2013 at 06:34 AM
Cuffy70 - Feb 3, 2013 at 03:36 AM

Hello,
I have been using Excel for a number of years but fairly new to formula etc.
I need a VBA code that can copy data from costing(raw data) to quote based on a certain condition matches.

Costing sheet
column---B(Description)-C(Quantity)-D(UOM)-E(Rate)-F(Total)

When a quantity is entered into column C i need the data from that row to transfer to :-

Quote sheet
column---B(Description)-E(Quantity)-F(UOM)-G(Rate)-H(Total)
But only the row that is relevent

Transferring data from one sheet to another
Automatically transfer data from one sheet to another in excel - Guide
How to transfer data from one sheet to another in excel using macros - Guide
Copy data from one Excel workbook to another - Guide
How to automatically transfer data from one sheet to another in excel - Guide
Automatically transfer data from one sheet to another ✓ - Forum - Excel

2 replies

Answer 1 / 2

rizvisa1

Posts: 4479
Registration date: Thursday January 28, 2010
Status: Contributor
Last seen: May 5, 2022

769
Jan 23, 2013 at 07:00 AM

what makes a row "relevant"
what about any existing info

may be post a sample workbook at some public file sharing site and post back here the link to the file itself back here would help in seeing what u want

Answer 2 / 2

cuffy70

Posts: 6
Registration date: Tuesday January 22, 2013
Status: Member
Last seen: January 29, 2013

Jan 23, 2013 at 07:58 AM

Hi rizvisa1
Apologies.
What i meant by relevant is i only want the row that has a quantity entered into it to transfer onto the next tab
Existing info should stay where it is

http://dl.dropbox.com/u/83123211/Maintenace%20costing%20sheet.xlsx

rizvisa1

Posts: 4479
Registration date: Thursday January 28, 2010
Status: Contributor
Last seen: May 5, 2022

769
Jan 23, 2013 at 09:51 PM

you have multiple sections, where will info should be copied
what if number of items selected is more than rows available currently in section
what is a value is entered in costing sheet and then removed
what if value is entered is negative or space or zero
why copy total, when the sheet already has formula to calculate total

cuffy70

Posts: 6
Registration date: Tuesday January 22, 2013
Status: Member
Last seen: January 29, 2013

Jan 24, 2013 at 03:27 AM

Not sure what your first question means?
I was actually looking at the problem of having more rows than available. Not sure if it is possible to automatically add rows into the section if required.
Is there a way of it removing the line if the value is removed.
There will not be any negative values or zeros. If there is no positive figure entered the item will not be selected.
Think you are probably right on this point. i would say Description, UOM and rate are the only items that need to be carried across.

rizvisa1

Posts: 4479
Registration date: Thursday January 28, 2010
Status: Contributor
Last seen: May 5, 2022

769
Jan 24, 2013 at 06:44 AM

the quote sheet had section for labor, material etc.I am guessing all goes under "Material". i was asking about that in line #1

cuffy70

Posts: 6
Registration date: Tuesday January 22, 2013
Status: Member
Last seen: January 29, 2013

Jan 24, 2013 at 09:24 AM

I understand now. I reckon the labour would be easier to be manually entered onto the quote sheet so maybe just leave that. All the rest would go under the material section.

rizvisa1

Posts: 4479
Registration date: Thursday January 28, 2010
Status: Contributor
Last seen: May 5, 2022

769
Jan 24, 2013 at 10:32 PM

In your sample book, you had a row i(row 31) n material section as not merged. Rest of section was merged. I would think that was an oversight. So first correct that issue. Macro will not work without it.

Before using this macro, you need to copy a function from this thread
https://ccm.net/forum/affich-606042-excel-vba2010-select-cells-between-2-keywords
function is "getItemLocation"

it starts with line
Public Function getItemLocation(sLookFor As String,

Copy the macro below, and also the function as mentioned before and then try this macro

Option Explicit

Public Sub populateQuote()
Dim quoteSheet                As String
Dim costSheet                 As String
Dim materialHeaderRow         As Long
Dim labourHeaderRow           As Long
Dim materialHeader            As String
Dim laborHeader               As String
Dim mergeStartCol             As String
Dim mergeEndCol               As String
Dim searchRange               As Range
Dim labourMaterialOffsetRow   As Integer
Dim tempSheet                 As String
Dim activeSheetName           As String
Dim costLastRow               As Long
Dim costLastColumn            As Integer
Dim diff                      As Long
Dim dayWorkHeader             As String
Dim dayWorkHeaderRow          As Long

   costSheet = "Costing"
   quoteSheet = "Quote"
   materialHeader = "EQUIPMENT / MATERIALS"
   laborHeader = "LABOUR"
   dayWorkHeader = "DAYWORK"
   mergeStartCol = "B"
   mergeEndCol = "D"
   labourMaterialOffsetRow = 3
   
   activeSheetName = ActiveSheet.Name
   With Sheets(costSheet)
      If (.Cells(1, 1) = vbNullString) Then .Cells(1, 1) = "a temp place holder"
      .AutoFilterMode = False
      costLastRow = getItemLocation("*", .Cells)
      costLastColumn = getItemLocation("*", .Cells, bFindRow:=False)
      dayWorkHeaderRow = getItemLocation(dayWorkHeader, .Cells)
      .Cells.AutoFilter Field:=3, Criteria1:="<>"
      Sheets.Add
      tempSheet = ActiveSheet.Name
      .Select
      Application.CutCopyMode = False
      If (dayWorkHeaderRow > 0) Then costLastRow = dayWorkHeaderRow
      .Range(.Cells(1, 1), .Cells(costLastRow, costLastColumn)).Copy
      Sheets(tempSheet).Cells(1, 1).PasteSpecial xlPasteValues
      Application.CutCopyMode = False
      .AutoFilterMode = False
      If (.Cells(1, 1) = "a temp place holder") Then .Cells(1, 1) = vbNullString
   End With
   
   With Sheets(tempSheet)
      costLastRow = getItemLocation("*", .Cells)
      .Application.CutCopyMode = False
      .Columns(mergeStartCol & ":" & mergeEndCol).Offset(columnOffset:=1).Insert
      .Range(.Cells(1, mergeStartCol), .Cells(1, mergeEndCol)).Offset(, 1).Merge
      Application.CutCopyMode = False
      .Range(.Cells(1, mergeStartCol), .Cells(1, mergeEndCol)).Offset(, 1).Copy
      .Range(.Cells(1, mergeStartCol), .Cells(costLastRow, mergeEndCol)).Offset(1, 1).PasteSpecial
      Application.CutCopyMode = False
      With .Range(.Cells(1, mergeStartCol), .Cells(costLastRow, mergeEndCol)).Offset(, 1)
         .NumberFormat = "general"
         .FormulaR1C1 = "=RC[-1]"
         Application.CutCopyMode = False
         .Copy
         .PasteSpecial xlPasteValues
         Application.CutCopyMode = False
      End With
      
   End With
   
   With Sheets(quoteSheet)
      Set searchRange = .Columns(mergeStartCol & ":" & mergeEndCol)
      materialHeaderRow = getItemLocation(materialHeader, searchRange, , False)
      If (materialHeaderRow = 0) Then
         MsgBox "Unable to locate '" & materialHeader & "' in range " & searchRange.Address
         GoTo Exit_populateQuote
      End If
      
      Set searchRange = .Range(.Cells(materialHeaderRow, mergeStartCol), .Cells(.Rows.Count, mergeEndCol))
      labourHeaderRow = getItemLocation(laborHeader, searchRange, , False)
      If (labourHeaderRow = 0) Then
         MsgBox "Unable to locate '" & laborHeader & "' in range " & searchRange.Address
         GoTo Exit_populateQuote
      End If
      
      .Range(.Cells(materialHeaderRow + 1, "B"), .Cells(labourHeaderRow - labourMaterialOffsetRow, "F")).ClearContents
      If (costLastRow > 1) Then
         diff = costLastRow - (labourHeaderRow - materialHeaderRow - labourMaterialOffsetRow) - 1
         If (diff > 0) Then
            Application.CutCopyMode = False
            .Rows(materialHeaderRow + 1).Copy
            .Rows(materialHeaderRow + 1 & ":" & materialHeaderRow + diff).Offset(1).Insert Shift:=xlDown
            Application.CutCopyMode = False
         End If
         
         Sheets(tempSheet).Range(Sheets(tempSheet).Cells(2, "B"), Sheets(tempSheet).Cells(costLastRow, "B")).Offset(, 1).Copy
         .Cells(materialHeaderRow + 1, "B").PasteSpecial xlPasteValues
         Application.CutCopyMode = False
         
         Sheets(tempSheet).Range(Sheets(tempSheet).Cells(2, "F"), Sheets(tempSheet).Cells(costLastRow, "F")).Copy
         .Cells(materialHeaderRow + 1, "F").PasteSpecial xlPasteValues
         Application.CutCopyMode = False
         
         Sheets(tempSheet).Range(Sheets(tempSheet).Cells(2, "H"), Sheets(tempSheet).Cells(costLastRow, "H")).Copy
         .Cells(materialHeaderRow + 1, "E").PasteSpecial xlPasteValues
         Application.CutCopyMode = False

      End If
   End With
   
Exit_populateQuote:
   Application.DisplayAlerts = False
   Sheets(tempSheet).Delete
   Application.DisplayAlerts = True
End Sub

Subscribe To Our Newsletter!