Columns to columns

D

doug5jmp

Board Regular
Joined
Apr 27, 2010
Messages
62
I have a data list

Item List 4/07/10 Blank 04/15/10 Blank YTD
Soap 3 Blank 2 5
Tp 3 Blank 3 6
PT 5 4 9

Each week a new date and amount is entered, and the sum for YTD is updated. I would like to copy only those columns that have a date entered and the YTD, to another worksheet with the same item list. The problem is when I select the range I end up with the blank columns as well. This has to be dynamic and have the new date and item numbers (column) update and be placed into the new worksheet when they are entered in the current worksheet. Note...The documents will be separate excel wkbks.

I am a novice and not sure what to do.
 
Sort by date Sort by votes
I than would have to enter a code in each of the two "source" files for each location and than into the destination file, correct?

Whereby the first source file has a submit button to the aggregate source file,
And the destination file has an update button to pull from the aggregate source file.

Which would be...
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
I just looked quickly through the previous posts as I've been struggling a bit with this following code.
It represents the code needed for importing all columns, from all listed workbooks. I haven't quite managed to test it thoroughly but it seems to work. This goes into the destination workbook.

So in essence after running all the previous posted code from all data sheets running this one should produce the same result.

Code: 
Sub datacopyAll()
Application.ScreenUpdating = False

Set listSht = ThisWorkbook.Sheets("Sheet3")  'destination sheet
Dim WkBArray()
WkBArray = Array("BookTest.xls", "BookTest2.xls") 'list all the workboks to be used

LastCol2 = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
listSht.Range(listSht.Cells(1, 2), listSht.Cells(LastRow, LastCol2)).ClearContents

For Each wkBfileName In WkBArray 'loop through all listed workbooks
Set wkB = Workbooks.Open(wkBfileName)
For Each wkS In wkB.Worksheets 'loop through all worksheets in opened workbook.
Set DataSht = wkS
LastCol = DataSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    For Col = 2 To LastCol - 2 'loops through all columns in source sheet from column B to the last column used
    LastCol2 = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'finds last used column in destination
        If DataSht.Cells(1, Col).Value <> "" Then 'test for an empty column, assumes any column with empty cell in row 1 is empty
        DataSht.Columns(Col).Copy 'copies whole column
        listSht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats) 'pastes numbers and formats to the destination sheet
        End If
    Next Col
  Next wkS
  Application.CutCopyMode = False
  wkB.Close
Next wkBfileName

LastCol2 = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
 With listSht
 If LastCol2 <> 2 Then ' checks whether a sort is neded, if so sorts by date header
 .Range(.Cells(1, 2), .Cells(LastRow, LastCol2)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
End If
If .Cells(1, LastCol2).Value = "YTD" Then 'checks whether YTD header is present
i = 0
j = -1
Else 'if not present creates it
.Cells(1, LastCol2 + 1).Value = "YTD"
i = 1
j = 0
End If
'updates YTD formulas
.Range(.Cells(2, LastCol2 + i), .Cells(LastRow, LastCol2 + i)).FormulaR1C1 = "=SUM(R" & Row & "C2:R" & Row & "C" & LastCol2 + j & ")"
End With
ThisWorkbook.Save 'saves source workbook
Application.ScreenUpdating = True 'turns screen updating back on
ThisWorkbook.Close False 'closes source workbook
End Sub
 
Upvote 0
I would avoid additional workbooks and worksheets.
As I said I think Excel will check the read/write capacity of the opened workbook.
The code could test the read write status and abort the copy if the destination is unwritable and ask the user to wait before trying again.
 
Upvote 0
'THIS WILL GO INTO THE DESTINATION WORKBOOK ONLY

Code: 
Sub datacopyAll()
Application.ScreenUpdating = False

Set listSht = ThisWorkbook.Sheets("Sheet3")  'destination sheet
Dim WkBArray()
WkBArray = Array("BookTest.xls", "BookTest2.xls") 'list all the workboks to be used

LastCol2 = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
listSht.Range(listSht.Cells(1, 2), listSht.Cells(LastRow, LastCol2)).ClearContents

For Each wkBfileName In WkBArray 'loop through all listed workbooks
Set wkB = Workbooks.Open(wkBfileName)
For Each wkS In wkB.Worksheets 'loop through all worksheets in opened workbook.
Set DataSht = wkS
LastCol = DataSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    For Col = 2 To LastCol - 2 'loops through all columns in source sheet from column B to the last column used
    LastCol2 = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'finds last used column in destination
        If DataSht.Cells(1, Col).Value <> "" Then 'test for an empty column, assumes any column with empty cell in row 1 is empty
        DataSht.Columns(Col).Copy 'copies whole column
        listSht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats) 'pastes numbers and formats to the destination sheet
        End If
    Next Col
  Next wkS
  Application.CutCopyMode = False
  wkB.Close
Next wkBfileName

LastCol2 = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = listSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
 With listSht
 If LastCol2 <> 2 Then ' checks whether a sort is neded, if so sorts by date header
 .Range(.Cells(1, 2), .Cells(LastRow, LastCol2)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
End If
If .Cells(1, LastCol2).Value = "YTD" Then 'checks whether YTD header is present
i = 0
j = -1
Else 'if not present creates it
.Cells(1, LastCol2 + 1).Value = "YTD"
i = 1
j = 0
End If
'updates YTD formulas
.Range(.Cells(2, LastCol2 + i), .Cells(LastRow, LastCol2 + i)).FormulaR1C1 = "=SUM(R" & Row & "C2:R" & Row & "C" & LastCol2 + j & ")"
End With
ThisWorkbook.Save 'saves source workbook
Application.ScreenUpdating = True 'turns screen updating back on
ThisWorkbook.Close False 'closes source workbook
End Sub
[/QUOTE]



snowblizz said:
...this code will be placed in the source workbook, in a code module.
It opens the destination workbook, copies over the last column, sorts and updates the destination YTD and closes and saves both workbooks.
Click to expand...
'FOR THE WORKBOOKS WITH ONE WORKSHEET

snowblizz said:
Code: 
Sub datacopySingle()
Application.ScreenUpdating = False
Set listWkB = Workbooks.Open("BookTest.xls") 'destiantion workbook
Set listsht = listWkB.Sheets("Sheet3")  'destination sheet
Set datasht = Workbooks(ThisWorkbook.Name).Activesheet  'source sheet, will always be the active sheet ie the one the button is placed on

LastCol = datasht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCol2 = listsht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    datasht.Columns(LastCol - 2).Copy
    listsht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats)

Application.CutCopyMode = False
LastCol2 = listsht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = listsht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row

 With listsht
 If LastCol2 <> 2 Then ' checks whether a sort is neded, if so sorts by date header
 .Range(.Cells(1, 2), .Cells(LastRow, LastCol2)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
End If
If .Cells(1, LastCol2).Value = "YTD" Then 'checks whether YTD header is present
i = 0
j = -1
Else 'if not present creates it
.Cells(1, LastCol2 + 1).Value = "YTD"
i = 1
j = 0
End If
'updates YTD formulas
.Range(.Cells(2, LastCol2 + i), .Cells(LastRow, LastCol2 + i)).FormulaR1C1 = "=SUM(R" & Row & "C2:R" & Row & "C" & LastCol2 + j & ")"
End With
ThisWorkbook.Save 'saves source workbook
listWkB.Save 'saves destination workbook
listWkB.Close False 'closes destination workbook
Application.ScreenUpdating = True 'turns screen updating back on
ThisWorkbook.Close False 'closes source workbook
End Sub

Then when you create the button on each sheet use the following code for the button click.
Code: 
Call datacopySingle
Click to expand...

snowblizz said:
It would be better to just keep pushing YTD "outwards" by inserting a new column for the user to enter data in.
Click to expand...
'WOULD THIS HAVE TO BE DONE BY THE PERSON OR AFTER THE DATA IS SAVED THE WORKSHEET PUSHES THE YTD TWO COLUMNS FROM THE LAST DATA ENTERED?'

snowblizz said:
The code will also require there be headers for column A in the destination workbook. The .Find method will not work if the destination workbook is completely empty.
Click to expand...
'WHAT WOULD THE HEADERS BE FOR THE DATES? AS THE DATE IS IN ITSELF THE HEADER?

snowblizz said:
This will take all the sheets in a workbook and copy the last column from each and paste it to the destination workbook, sort everything by date. And then save and close both workbooks. Also placed in a module in the source worksheet.
Click to expand...
'FOLLOWING CODE IS FOR THE WORKBOOK WITH MULTIPLE WORKSHEETS, SO SHOULD THE BUTTON BE
Code: 
 Call datacopyMultiSingle

snowblizz said:
Code: 
Sub datacopyMultiSingle()
Application.ScreenUpdating = False
Set listWkB = Workbooks.Open("BookTest.xls", Notify:=True) 'destiantion workbook
Set listsht = listWkB.Sheets("Sheet3")  'destination sheet

For Each wkS In ThisWorkbook.Worksheets
Set datasht = wkS  'source sheet
LastCol = datasht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCol2 = listsht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    datasht.Columns(LastCol - 2).Copy
    listsht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
Next
Application.CutCopyMode = False
LastCol2 = listsht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = listsht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row

 With listsht
 If LastCol2 <> 2 Then ' checks whether a sort is neded, if so sorts by date header
 .Range(.Cells(1, 2), .Cells(LastRow, LastCol2)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal 'sorts the columns starting from column B, row 1
End If
If .Cells(1, LastCol2).Value = "YTD" Then 'checks whether YTD header is present in row 1, column [whatever the last column is]
i = 0
j = -1
Else 'if not present creates it
.Cells(1, LastCol2 + 1).Value = "YTD"
i = 1
j = 0
End If
'updates YTD formulas
.Range(.Cells(2, LastCol2 + i), .Cells(LastRow, LastCol2 + i)).FormulaR1C1 = "=SUM(R" & Row & "C2:R" & Row & "C" & LastCol2 + j & ")"
End With
ThisWorkbook.Save 'saves source workbook
listWkB.Save 'saves destination workbook
listWkB.Close False 'closes destination workbook
Application.ScreenUpdating = True 'turns screen updating back on
ThisWorkbook.Close False 'closes source workbook
End Sub
Click to expand...

'WITH THE ADDED BUTTON, CAN IT BE ALTERED? AS STATED BEFORE SHOW RED OR GREEN ETC.? ALSO CAN WE USE AN IMG SOURCE FOR THE BUTTON?
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Remove Duplicates with Dynamic Columns Array
Replies
0
Views
283
trough
T
P
  • Solved
Copy Template Sheet
Replies
6
Views
98
paulsolar
P
N
  • Solved
Insert new dates with dynamic formula to include new range
Replies
5
Views
78
Peter_SSs
Peter_SSs
K
  • Question
Populate column C with repeated entries based on count for each row in column A?
Replies
3
Views
98
Peter_SSs
Peter_SSs
M
  • Question
VBA Code to copy rows by date from one tab to another / repeat based on new date
Replies
3
Views
211
kevin9999
K

Forum statistics

Threads
1,214,591
Messages
6,120,427
Members
448,961
Latest member
nzskater

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