Auto Copy columns between sheets

one_andy

New Member
Joined
Nov 16, 2009
Messages
6
Hi,

I would like to copy a column from sheet "data base" to sheet "Destination".
I would like an automatically feature for this function.
Eg. When somebody puts a new row in a column in sheet "data base"
then the sheet "Destination" automatically updates the changed column.
All help is appreciated.

Thanks in advance!
/Andy
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

one_andy

New Member
Joined
Nov 16, 2009
Messages
6
Please, I would really like to know if you need to write a VBA-code or if there is a formula for this?

Thanks in Advance!
 

Lewiy

Well-known Member
Joined
Jan 5, 2007
Messages
4,284
Try this in the worksheet module for "data base"

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets("data base").Cells.Copy Sheets("Destination").Cells
End Sub
 

one_andy

New Member
Joined
Nov 16, 2009
Messages
6
Thanks a lot!
It works fine, except the long loading time afterwards.
But when it comes to copy just a single column to a specified column in another sheet, I tried this formula in the "destination" cell (eg. in B1).

=database!A3

So when I want to copy a longer column I just drag (AutoFill) this formula longer down the sheet (eg. to A20). And then everything from "database" and cells A3:A20 is copied to "destination" and cells B1:B18. Thus I would rather want the whole column to update automatically between the sheets without me having to drag in each column manually.
That is what I try to find out now...
 

one_andy

New Member
Joined
Nov 16, 2009
Messages
6

ADVERTISEMENT

Try this in the worksheet module for "data base"

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets("data base").Cells.Copy Sheets("Destination").Cells
End Sub
Another idea is to change the code above to copy just the specified columns in the sheet "Hardware" into specified columns in "Destination". Would it be something like this (the idea):

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets("Hardware").Columns("A").Cells.Copy
    Sheets("Destination").Columns("C").Cells
End Sub
I am new into this VBA programming, so please revise the code above.

Thanks!
 

Zack Barresse

MrExcel MVP
Joined
Dec 9, 2003
Messages
10,881
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
  3. Web
Hi there,

Can I ask what the purpose is? I wouldn't copy the entire sheet every change. Perhaps every cell in the range desired to be copied. But certainly you can explain what it is you are trying to achieve here.
 

one_andy

New Member
Joined
Nov 16, 2009
Messages
6
It’s like this: I have made an excel sheet from which you can filter forward Hardware products, after making some choices. I have got some help to make the UserForm, which behaves like an auto filter. <o:p></o:p>
<o:p></o:p>
<o:p></o:p>

The Form takes its information and list titles from the “Data” sheet which in turn takes information from the “Hardware” sheet which is the original Data base. As “Hardware“ is an updatable sheet you can insert new components in the columns, therefore the “Data” sheet needs to be synced with “Hardware”. So that when you insert new components in “Hardware” the choices in the UserForm (“Main” sheet) will update. <o:p></o:p>

<o:p></o:p>
<o:p></o:p>

Now I want some columns in “Data” to sync with some columns in “Hardware”. Eg. I want the F column (from F3 and downwards) in “Data” to sync with the B column (from B7 and downwards) in “Hardware” etc. As a provisional method I wrote the function =Hardware!B7 in cell F3 in “Data” and then dragged the function down to cell F800 (in case we get this many components). As there isn’t more than 700 components the last cells gets an 0 and when it gets more than 800 components you have to fill in the function again. <o:p></o:p>

http://www.flickr.com/photos/44776933@N03/4113957409/<o:p></o:p>
http://www.flickr.com/photos/44776933@N03/4113957549/<o:p></o:p>

This doesn’t seem too professional, so what I need is a code in the sheet to take care of this.
That is what I need help with.<o:p></o:p>

The Code in the UserForm (if you need it)<o:p></o:p>:
Code:
<o:p></o:p>
  Option Explicit<o:p></o:p>
  <o:p> </o:p>
  Const MAX_ROW = 2000<o:p></o:p>
  Const MAX_COLUMN = 20<o:p></o:p>
  Const DATA_START_ROW = 3<o:p></o:p>
  <o:p> </o:p>
  Dim nNoEmptyRow As Integer<o:p></o:p>
  Dim xTitle(MAX_COLUMN) As String<o:p></o:p>
  Dim xConditionColumn    ' for all columns used in the form<o:p></o:p>
  <o:p> </o:p>
  Const START_ROW_NUMBER = 5  ' visningsark<o:p></o:p>
  Dim bCheck As Boolean<o:p></o:p>
  <o:p> </o:p>
  ' Show the second choice<o:p></o:p>
  Private Sub cboItem1_Change()<o:p></o:p>
      If bCheck = False Then Exit Sub<o:p></o:p>
      Dim strTerm1 As String, dummy As String, I As Integer, K As Integer<o:p></o:p>
      Dim bFound As Boolean<o:p></o:p>
      strTerm1 = cboItem1.Text<o:p></o:p>
      cboItem2.Clear<o:p></o:p>
      For I = 0 To nNoEmptyRow - 1<o:p></o:p>
          If (strTerm1 = xConditionColumn(I, 0)) Then<o:p></o:p>
              dummy = xConditionColumn(I, 1)<o:p></o:p>
              If dummy <> "" Then<o:p></o:p>
                  bFound = False<o:p></o:p>
                  For K = 0 To cboItem2.ListCount - 1<o:p></o:p>
                      If dummy = cboItem2.List(K) Then<o:p></o:p>
                          bFound = True<o:p></o:p>
                          Exit For<o:p></o:p>
                      End If<o:p></o:p>
                  Next K<o:p></o:p>
                  If bFound = False Then<o:p></o:p>
                      cboItem2.AddItem dummy<o:p></o:p>
                      If cboItem2.Text = "" Then cboItem2.Text = dummy<o:p></o:p>
                  End If<o:p></o:p>
              End If<o:p></o:p>
          End If<o:p></o:p>
      Next I<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  Private Sub cboItem2_Change()<o:p></o:p>
      If bCheck = False Then Exit Sub<o:p></o:p>
      Dim strTerm1 As String, strTerm2 As String<o:p></o:p>
      Dim dummy As String, I As Integer, K As Integer<o:p></o:p>
      Dim bFound As Boolean<o:p></o:p>
      strTerm1 = cboItem1.Text<o:p></o:p>
      strTerm2 = cboItem2.Text<o:p></o:p>
      cboItem3.Clear<o:p></o:p>
      For I = 0 To nNoEmptyRow - 1<o:p></o:p>
          If (strTerm1 = xConditionColumn(I, 0)) And (strTerm2 = xConditionColumn(I, 1)) Then<o:p></o:p>
              dummy = xConditionColumn(I, 2)<o:p></o:p>
              If dummy <> "" Then<o:p></o:p>
                  bFound = False<o:p></o:p>
                  For K = 0 To cboItem3.ListCount - 1<o:p></o:p>
                      If dummy = cboItem3.List(K) Then<o:p></o:p>
                          bFound = True<o:p></o:p>
                          Exit For<o:p></o:p>
                      End If<o:p></o:p>
                  Next K<o:p></o:p>
                  If bFound = False Then<o:p></o:p>
                      cboItem3.AddItem dummy<o:p></o:p>
                      If cboItem3.Text = "" Then cboItem3.Text = dummy<o:p></o:p>
                  End If<o:p></o:p>
              End If<o:p></o:p>
          End If<o:p></o:p>
      Next I<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  Private Sub cboItem3_Change()<o:p></o:p>
      If bCheck = False Then Exit Sub<o:p></o:p>
      Dim strTerm1 As String, strTerm2 As String, strTerm3 As String<o:p></o:p>
      Dim dummy As String, I As Integer, K As Integer<o:p></o:p>
      Dim bFound As Boolean<o:p></o:p>
      strTerm1 = cboItem1.Text<o:p></o:p>
      strTerm2 = cboItem2.Text<o:p></o:p>
      strTerm3 = cboItem3.Text<o:p></o:p>
      cboItem4.Clear<o:p></o:p>
      For I = 0 To nNoEmptyRow - 1<o:p></o:p>
          If (strTerm1 = xConditionColumn(I, 0)) And (strTerm2 = xConditionColumn(I, 1)) And (strTerm3 = xConditionColumn(I, 2)) Then<o:p></o:p>
              dummy = xConditionColumn(I, 3)<o:p></o:p>
              If dummy <> "" Then<o:p></o:p>
                  bFound = False<o:p></o:p>
                  For K = 0 To cboItem4.ListCount - 1<o:p></o:p>
                      If dummy = cboItem4.List(K) Then<o:p></o:p>
                          bFound = True<o:p></o:p>
                          Exit For<o:p></o:p>
                      End If<o:p></o:p>
                  Next K<o:p></o:p>
                  If bFound = False Then<o:p></o:p>
                      cboItem4.AddItem dummy<o:p></o:p>
                      If cboItem4.Text = "" Then cboItem4.Text = dummy<o:p></o:p>
                  End If<o:p></o:p>
              End If<o:p></o:p>
          End If<o:p></o:p>
      Next I<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  Private Sub cboItem4_Change()<o:p></o:p>
      If bCheck = False Then Exit Sub<o:p></o:p>
      Dim strTerm1 As String, strTerm2 As String, strTerm3 As String, strTerm4 As String<o:p></o:p>
      Dim dummy As String, I As Integer, K As Integer<o:p></o:p>
      Dim bFound As Boolean<o:p></o:p>
      strTerm1 = cboItem1.Text<o:p></o:p>
      strTerm2 = cboItem2.Text<o:p></o:p>
      strTerm3 = cboItem3.Text<o:p></o:p>
      strTerm4 = cboItem4.Text<o:p></o:p>
      lstMore.Clear<o:p></o:p>
      For I = 0 To nNoEmptyRow - 1<o:p></o:p>
          If (strTerm1 = xConditionColumn(I, 0)) And (strTerm2 = xConditionColumn(I, 1)) And (strTerm3 = xConditionColumn(I, 2)) And (strTerm4 = xConditionColumn(I, 3)) Then<o:p></o:p>
              dummy = xConditionColumn(I, 4)<o:p></o:p>
              If dummy <> "" Then<o:p></o:p>
                  bFound = False<o:p></o:p>
                  For K = 0 To lstMore.ListCount - 1<o:p></o:p>
                      If dummy = lstMore.List(K) Then<o:p></o:p>
                          bFound = True<o:p></o:p>
                          Exit For<o:p></o:p>
                      End If<o:p></o:p>
                  Next K<o:p></o:p>
                  If bFound = False Then<o:p></o:p>
                      lstMore.AddItem dummy<o:p></o:p>
                  End If<o:p></o:p>
              End If<o:p></o:p>
          End If<o:p></o:p>
      Next I<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  Private Sub cmdOK_Click()<o:p></o:p>
      DisplayChoice<o:p></o:p>
      Unload Me<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  Private Sub DisplayChoice()<o:p></o:p>
      Dim I As Integer, J As Integer<o:p></o:p>
      Dim v1 As String, v2 As String, v3 As String, v4 As String, v5 As String<o:p></o:p>
      <o:p></o:p>
      For J = 1 To MAX_COLUMN<o:p></o:p>
          Cells(START_ROW_NUMBER - 1, J + 1) = xTitle(J)<o:p></o:p>
      Next J<o:p></o:p>
  <o:p> </o:p>
      v1 = cboItem1.Text<o:p></o:p>
      v2 = cboItem2.Text<o:p></o:p>
      v3 = cboItem3.Text<o:p></o:p>
      v4 = cboItem4.Text<o:p></o:p>
      ' här skriva logik för att visa rader som hittade
      Dim iRow As Integer<o:p></o:p>
      iRow = START_ROW_NUMBER<o:p></o:p>
      For I = 0 To nNoEmptyRow<o:p></o:p>
          If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 2).Value) = v1 Then<o:p></o:p>
              If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 3).Value) = v2 Then<o:p></o:p>
                  If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 4).Value) = v3 Then<o:p></o:p>
                      If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 5).Value) = v4 Then<o:p></o:p>
                          For J = 0 To lstMore.ListCount - 1<o:p></o:p>
                              If lstMore.Selected(J) = True Then<o:p></o:p>
                                  If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 6).Value) = lstMore.List(J) Then<o:p></o:p>
                                      DisplayFoundRow iRow, I + DATA_START_ROW<o:p></o:p>
                                      iRow = iRow + 1<o:p></o:p>
                                  End If<o:p></o:p>
                              End If<o:p></o:p>
                          Next J<o:p></o:p>
                      End If<o:p></o:p>
                  End If<o:p></o:p>
              End If<o:p></o:p>
          End If<o:p></o:p>
      Next I<o:p></o:p>
  End Sub<o:p></o:p>
  Private Sub DisplayFoundRow(ByVal iRow As Integer, ByVal iOriginal As Integer)<o:p></o:p>
      Dim J As Integer<o:p></o:p>
      For J = 1 To MAX_COLUMN<o:p></o:p>
          Cells(iRow, J) = Sheets("Data").Cells(iOriginal, J)<o:p></o:p>
      Next J<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  ' Initialize the form data<o:p></o:p>
  Private Sub UserForm_Initialize()<o:p></o:p>
      bCheck = False<o:p></o:p>
      Dim I As Integer, J As Integer, dummy As String<o:p></o:p>
      If (IsSheetExist("Main") = False) Then<o:p></o:p>
          MsgBox "Det finns ingen data ark!"
          Exit Sub<o:p></o:p>
      End If<o:p></o:p>
      <o:p></o:p>
      lstMore.Clear<o:p></o:p>
      cboItem1.Clear<o:p></o:p>
      cboItem2.Clear<o:p></o:p>
      cboItem3.Clear<o:p></o:p>
      cboItem4.Clear<o:p></o:p>
      'Sheets("Data").Select<o:p></o:p>
      ' fetch title<o:p></o:p>
      For J = 1 To MAX_COLUMN<o:p></o:p>
          xTitle(J - 1) = Sheets("Data").Cells(2, J)<o:p></o:p>
      Next J<o:p></o:p>
      lblItem1.Caption = xTitle(1)<o:p></o:p>
      lblItem2.Caption = xTitle(2)<o:p></o:p>
      lblItem3.Caption = xTitle(3)<o:p></o:p>
      lblItem4.Caption = xTitle(4)<o:p></o:p>
      lblItem5.Caption = xTitle(5)<o:p></o:p>
      ' Fetch all columns used in the dialog<o:p></o:p>
      nNoEmptyRow = 0<o:p></o:p>
      For I = DATA_START_ROW To MAX_ROW<o:p></o:p>
          If Sheets("Data").Cells(I, 1) = "" Then Exit For<o:p></o:p>
          nNoEmptyRow = nNoEmptyRow + 1<o:p></o:p>
      Next I<o:p></o:p>
      ReDim xConditionColumn(nNoEmptyRow, 5)<o:p></o:p>
      For I = DATA_START_ROW To nNoEmptyRow<o:p></o:p>
          xConditionColumn(I - DATA_START_ROW, 0) = CStr(Sheets("Data").Cells(I, 2).Value)<o:p></o:p>
          xConditionColumn(I - DATA_START_ROW, 1) = CStr(Sheets("Data").Cells(I, 3).Value)<o:p></o:p>
          xConditionColumn(I - DATA_START_ROW, 2) = CStr(Sheets("Data").Cells(I, 4).Value)<o:p></o:p>
          xConditionColumn(I - DATA_START_ROW, 3) = CStr(Sheets("Data").Cells(I, 5).Value)<o:p></o:p>
          xConditionColumn(I - DATA_START_ROW, 4) = CStr(Sheets("Data").Cells(I, 6).Value)<o:p></o:p>
      Next I<o:p></o:p>
      For I = 0 To nNoEmptyRow - 1<o:p></o:p>
          dummy = CStr(Sheets("Data").Cells(I + DATA_START_ROW, 2).Value)<o:p></o:p>
          If dummy <> "" Then Call AddComboCellIfNotExist(cboItem1, dummy)<o:p></o:p>
          <o:p></o:p>
  '        dummy = CStr(Sheets("Data").Cells(I, 3).Value)<o:p></o:p>
  '        If dummy <> "" Then Call AddComboCellIfNotExist(cboItem2, dummy)<o:p></o:p>
  <o:p> </o:p>
  '        dummy = CStr(Sheets("Data").Cells(I, 4).Value)<o:p></o:p>
  '        If dummy <> "" Then Call AddComboCellIfNotExist(cboItem3, dummy)<o:p></o:p>
  <o:p> </o:p>
  '        dummy = CStr(Sheets("Data").Cells(I, 5))<o:p></o:p>
  '        If dummy <> "" Then Call AddComboCellIfNotExist(cboItem4, dummy)<o:p></o:p>
  <o:p> </o:p>
  '        dummy = CStr(Sheets("Data").Cells(I, 6).Value)<o:p></o:p>
  '        If dummy <> "" Then<o:p></o:p>
              'Call AddListCellIfNotExist(ListBox1, dummy)<o:p></o:p>
  '            Dim K As Integer, bFound As Boolean<o:p></o:p>
  '            bFound = False<o:p></o:p>
  '            For K = 0 To lstMore.ListCount - 1<o:p></o:p>
  '                If dummy = lstMore.List(K) Then<o:p></o:p>
  '                    bFound = True<o:p></o:p>
  '                    Exit For<o:p></o:p>
  '                End If<o:p></o:p>
  '            Next K<o:p></o:p>
  '            If bFound = False Then lstMore.AddItem dummy<o:p></o:p>
  '        End If<o:p></o:p>
      Next I<o:p></o:p>
  '    cboItem1.Text = cboItem1.List(0)<o:p></o:p>
  '    cboItem2.Text = cboItem2.List(0)<o:p></o:p>
  '    cboItem3.Text = cboItem3.List(0)<o:p></o:p>
  '    cboItem4.Text = cboItem4.List(0)<o:p></o:p>
  '    lstMore.Selected(0) = True<o:p></o:p>
      Sheets("Main").Select<o:p></o:p>
      bCheck = True<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  Private Sub AddComboCellIfNotExist(ByRef obj1 As ComboBox, str As String)<o:p></o:p>
      Dim I As Integer<o:p></o:p>
      For I = 0 To obj1.ListCount - 1<o:p></o:p>
          If str = obj1.List(I) Then<o:p></o:p>
              Exit Sub<o:p></o:p>
          End If<o:p></o:p>
      Next I<o:p></o:p>
      obj1.AddItem str<o:p></o:p>
  End Sub<o:p></o:p>
  <o:p> </o:p>
  ' check the existence of sheet, clear if found<o:p></o:p>
  Private Function IsSheetExist(ByVal strSheetName As String) As Boolean<o:p></o:p>
      On Error GoTo errHandle<o:p></o:p>
      Sheets(strSheetName).Select<o:p></o:p>
      Cells.Select<o:p></o:p>
      Selection.ClearContents<o:p></o:p>
      Cells(1, 1).Select<o:p></o:p>
      IsSheetExist = True<o:p></o:p>
      Exit Function<o:p></o:p>
  errHandle:<o:p></o:p>
      IsSheetExist = False<o:p></o:p>
  End Function<o:p></o:p>
<o:p></o:p>
Couldn’t keep it shorter :D, pardon me.<o:p></o:p>
But hope you understand me.<o:p></o:p>
Thanks for helping!<o:p></o:p>
 

Watch MrExcel Video

Forum statistics

Threads
1,129,754
Messages
5,638,170
Members
417,011
Latest member
Amaden95

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
Top