I'm looking for a way or method to copy (adding new) columns between sheets.
Let me illustrate:
Sheet: template
Sheet: student
Initially I duplicate "Template" and rename it.
But when additional tasks are added to "Template" I want to update "Student" minding that I have already changed the content in range B2:D4. So copy/pasting the whole range is not an option.
What's the best way to go about this?
First checking if row A in the destination sheet has a value, if not copy/paste that column?
A push in the right direction (or some code to get started on) would be very much appreciated.
You can achieve this by looping true columns headers, given they are in the first row and all tabs are named appropriately:
Sub AddTask()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.AskToUpdateLinks = False
.DisplayStatusBar = True
End With
Dim wb As Workbook: Set wb = ThisWorkbook
With wb
Dim LastTemplateCol As Long: LastTemplateCol = .Worksheets("Template").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To LastTemplateCol
Dim TempTask As String: TempTask = .Worksheets("Template").Cells(1, i).Value
Dim LastStudentCol As Long: LastStudentCol = .Worksheets("Student").Cells(1, Columns.Count).End(xlToLeft).Column
For t = 2 To LastStudentCol
Dim StudTask As String: StudTask = .Worksheets("Student").Cells(1, t).Value
Dim Exists As Boolean: Exists = False
If TempTask = StudTask Then
Exists = True
GoTo taskloop:
Else
GoTo studloop:
End If
studloop:
Next t
If Exists = False Then
.Worksheets("Template").Cells(1, i).Columns.EntireColumn.Copy
.Worksheets("Student").Cells(1, LastStudentCol + 1).PasteSpecial
End If
taskloop:
Next i
End With
Application.CutCopyMode = False
End Sub
Related
I wrote below script but get hung up on this part of the code:
If TargetWb.Sheets("Expenses").Range("F61").Offset(0, i - 1).Value = CVErr(xlErrNA) Then GoTo Skip Else GoTo Continue
What I'm trying to do: if the value of the cell returns #N/A as part of a function I would like to move to next loop. Any recommendation on how to accomplish this?
Thanks in advance for solutions. Also always open to recommendations on how to better structure this code, as I'm still a beginner.
Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim S_Deal As Range
Dim i As Integer
'SourceWb - Workbook were data is copied from
'TargetWb - Workbook were data is copied to and links are stored
Application.ScreenUpdating = False
Set TargetWb = ThisWorkbook
filePath = ThisWorkbook.Sheets("Expenses").Range("S4").Value
Set SourceWb = Workbooks.Open(filePath)
For i = 1 To 6
If TargetWb.Sheets("Expenses").Range("F61").Offset(0, i - 1).Value = CVErr(xlErrNA) Then GoTo Skip Else GoTo Continue
Continue:
Set S_Deal = TargetWb.Sheets("Expenses").Cells(11, 5 + i)
SourceWb.ActiveSheet.Range("OPEX_Control").Value = S_Deal.Value
TargetWb.Sheets("Expenses").Range("F12:F15").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("P9:P12").Value
TargetWb.Sheets("Expenses").Range("F18:F21").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o14:o17").Value
TargetWb.Sheets("Expenses").Range("F23:F26").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o19:o22").Value
TargetWb.Sheets("Expenses").Range("F29").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o25").Value
Skip:
Next i
Application.ScreenUpdating = True
End Sub
If you want to check whether the excel function return #N/A in vba, you can use the following code:
If Application.WorksheetFunction.IsNA(Cells(intRow, x)) Then
Since what you want is the execute a code unless the the wb.function is not #N/A, by re-arrange your If VBA code should be able to achieve your desired outcome.
If Application.WorksheetFunction.IsNA(TargetWb.Sheets("Expenses").Range("F61")) = false then
{your code}
end if
next i
So when the wb function return #N/A, it will not execute the code in between and go to next loop
it's me, again.
I have a code that import a reference sheet on wb_open. Im trying something new to get my code faster but it's creating a problem.
My new code delete (instead of copi-pasting) the existing internal Ref sheet and replace is by the external (refreshed or not) one.
The problem comes from the fact that deleting the internal ref sheet deletes my in-cell reference to that sheet even tho im naming the newly copied sheet the exact same name. Is there a way to get around?
Sub Workbook_open()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim Sheetname As String
Sheetname = "cédule détaillée 2 "
Worksheets(Sheetname).Visible = True
Dim externalwb As Workbook
Set externalwb = Workbooks.Open(fileName:="\\Backup\Opérations\Coaticook\Planification\Cédule détaillées\Cédule détaillées des composantes.xlsx")
Dim curentSheetNumber As Long
currentSheetNumber = ThisWorkbook.Worksheets(Sheetname).Index
ThisWorkbook.Worksheets(Sheetname).Delete
externalwb.Worksheets(Sheetname).Copy After:=ThisWorkbook.Worksheets(currentSheetNumber - 1)
externalwb.Close False
Worksheets(Sheetname).Visible = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Try implementing the next formula copying approach, please:
Sub testCopyFormulas()
Dim sh As Worksheet, rngForm As Range, shN As Worksheet
Set sh = ActiveSheet
Set rngForm = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
Set shN = Worksheets.Add
shN.Range(rngForm.Address).Formula = rngForm.Formula
End Sub
And specifically in your code, try this approach:
'...your code...
Dim externalwb As Workbook, rngForm As Range
Set externalwb = Workbooks.Open(fileName:="\\Backup\Opérations\Coaticook\Planification\Cédule détaillées\Cédule détaillées des composantes.xlsx")
Dim curentSheetNumber As Long
Set rngForm = ThisWorkbook.Worksheets(Sheetname).SpecialCells(xlCellTypeFormulas)
currentSheetNumber = ThisWorkbook.Worksheets(Sheetname).Index
ThisWorkbook.Worksheets(Sheetname).Delete
externalwb.Worksheets(Sheetname).Copy After:=ThisWorkbook.Worksheets(currentSheetNumber - 1)
externalwb.Close False
ThisWorkbook.Worksheets(Sheetname).Range(rngForm.Address).Formula = rngForm.Formula
'...Your code...
I have named a number of columns as ranges e.g.
DesCond1, DesDiff1, Comparison1, DesCond2, DesDiff2, Etc...
I have some buttons which use a macro to toggle the different columns visible or hidden. I have added the code I am using for one of these buttons.
Currently I have written the code to show or hide each range individually but I would like a code that will count the number of ranges with a similar name (DesCond1, DesCond2.. DesCond(n))and then loop through each one automatically checking the hidden status so I don't have to add to the code everytime I add more data. Here is my code so far. This works fine so far.
Sub ComparisonToggle1()
Dim ComparisonAll As Range, R_Cond As Range, R_Diff As Range
'set first of each range as identifier for decisions
Set R_Comp = Range("Comparison1")
'set all ranges under one name
Set CompAll = Union(Range("Comparison1"), Range("Comparison2"), Range("Comparison3")) 'name and add when new tests are added
If R_Comp.EntireColumn.Hidden = False Then 'False
CompAll.EntireColumn.Hidden = True 'hide all
ElseIf R_Comp.EntireColumn.Hidden = True Then 'True
CompAll.EntireColumn.Hidden = False 'vis all
End If
End Sub
Sub DesignToggle1()
Dim DesCondAll As Range, DesDiffAll As Range, R_Cond As Range, R_Diff As Range
'set first of each range as identifier for decisions
Set R_Cond = Range("DesCond1")
Set R_Diff = Range("DesDiff1")
'set all ranges under one name
Set DesCondAll = Union(Range("DesCond1"), Range("DesCond2"), Range("DesCond3"), Range("DesCond4"), Range("DesCond5"), Range("DesCond6")) 'name and add when new tests are added
Set DesDiffAll = Union(Range("DesDiff1"), Range("DesDiff2"), Range("DesDiff3"), Range("DesDiff4"), Range("DesDiff5"), Range("DesDiff6")) 'name and add when new tests are added
If R_Cond.EntireColumn.Hidden = False And R_Diff.EntireColumn.Hidden = False Then 'False/False
DesCondAll.EntireColumn.Hidden = True 'both hidden
DesDiffAll.EntireColumn.Hidden = True
ElseIf R_Cond.EntireColumn.Hidden = True And R_Diff.EntireColumn.Hidden = False Then 'True/False
DesCondAll.EntireColumn.Hidden = False 'vis both
DesDiffAll.EntireColumn.Hidden = False
ElseIf R_Cond.EntireColumn.Hidden = False And R_Diff.EntireColumn.Hidden = True Then 'False/True
DesCondAll.EntireColumn.Hidden = False 'vis both
DesDiffAll.EntireColumn.Hidden = False
ElseIf R_Cond.EntireColumn.Hidden = True And R_Diff.EntireColumn.Hidden = True Then 'True/True
DesCondAll.EntireColumn.Hidden = False 'vis both
DesDiffAll.EntireColumn.Hidden = False
End If
End Sub
This is to loop through all the names in your workbook, thought you need to give it the group you want to filter:
Option Explicit
Sub Test(Group As String)
Dim MyName As Name
For Each MyName In ThisWorkbook.Names
If MyName.Name Like "*" & Group & "*" Then
Range(MyName).EntireColumn.Hidden = True
End If
Next MyName
End Sub
Sub Main()
'This procedure calls the Test procedure feeding the variable Group as "Descond"
Test "Descond"
End Sub
I have a list of files with the same structure and I want to extract some information from columns A, B, and C and print it to another workbook.
I found a way to do it for a single file, but now I don't understand how can I do it using the list of given files. I tried using collections, but it doesn't work.
Here's what I came up with:
Sub Pulsante1_Click()
Dim FileGeStar As Variant
Dim myCol As Collection
Set myCol = New Collection
myCol.Add "C:\Users\xxx\Desktop\articoli_def.xlsx"
myCol.Add "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx"
For Each FileGeStar In myCol
Workbooks.Open Filename:=FileGeStar
FileGeStar = Application.ActiveWorkbook.Name
Dim Code As String
Dim Description As String
Dim FilePath As String
Dim i As Long
i = 2
While Range("A" & i) <> ""
FilePath = Application.ActiveWorkbook.Path
Code = Trim(Range("A" & i).Value)
Description = Trim(Range("B" & i).Value)
Workbooks("Report.xlsm").Worksheets(1).Range("A" & i).Value = FilePath
Workbooks("Report.xlsm").Worksheets(1).Range("B" & i).Value = Code
Workbooks("Report.xlsm").Worksheets(1).Range("C" & i).Value = Description
i = i + 1
Wend
Next FileGeStar
End Sub
What can I do?
This might look like an overkill, but I hope the code and comment's are self explanatory:
Option Explicit
Sub Pulsante1_Click()
Dim DestinationWorkbook As Workbook
Set DestinationWorkbook = ThisWorkbook 'I think report.xlsm is the workbook running the code
'if report.xlsm is not the workbook running the code then change thisworkbook for workbooks("Report.xlsm")
'add as many paths as you need to, another way would be to write them in a sheet and loop through to fill the array
Dim MyPaths As Variant
MyPaths = Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'Declare a workbook variable for the source workbooks
Dim SourceWorkbook As Workbook
'Declare a long variable to loop through your path's array
Dim i As Long
'loop through the start to the end of your array (will increase as the array does)
For i = LBound(MyPaths) To UBound(MyPaths)
Set SourceWorkbook = OpenWorkbook(MyPaths(i)) 'this will set the workbook variable and open it
CopyData SourceWorkbook, DestinationWorkbook 'this will copy the data to your destination workbook
SourceWorkbook.Close , False
Set SourceWorkbook = Nothing
Next i
End Sub
Private Function OpenWorkbook(FullPath As String) As Workbook
Set OpenWorkbook = Workbooks.Open(FullPath, False, True)
End Function
Private Sub CopyData(wbO As Workbook, wbD As Workbook)
'this procedure calculates the last row of your source workbook and loops through all it's data
'later calls the AddDataToMasterWorkbook procedure to paste the data
With wbO.Sheets(1) 'Im assuming your source workbook has the data on sheet1
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Dim FilePath As String
FilePath = wbO.Path
Dim Code As String
Dim Description As String
Dim C As Range
For Each C In .Range("A2:A" & LastRow) 'this will loop from A2 to the last row with data
Code = Trim(C)
Description = Trim(C.Offset(, 1))
AddDataToMasterWorkbook wbD, FilePath, Code, Description
Next C
End With
End Sub
Private Sub AddDataToMasterWorkbook(wb As Workbook, FilePath As String, Code As String, Description As String)
'This procedure calculates the last row without data and adds the items you need every time
With wb.Sheets(1)
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow) = FilePath
.Range("B" & LastRow) = Code
.Range("C" & LastRow) = Description
End With
End Sub
To loop though files, you can indeed use a collection, or an array, you can also loop through all files in directory with certain extension, or partial file name. Check out DIR function.
Best not to use ActiveWorkbook, better approach would be to set a workbook object like so: Set wb = Workbooks.Open(fullPathToYourWorkbook).
For what you're doing, there's no need to go row by row, much more efficient way would be to copy entire range, not only it's a lot quicker but also it's only 1 line of code; assuming your destination is ThisWorkbook.Sheets(1) and wb object is set: wb.Range("A:C").Copy Destination:=Thisworkbook.Sheets(1).Range("A:C"). If you need to edit copied data (trim or whatever) consider Range Replace method.
However, if you want to go row by row for whatever reason, as BigBen mentioned in the comment - get rid of While loop.
It's a good idea to set Application.ScreenUpdating to False when opening/closing workbooks, then back to True once it's all done. It will prevent user from accidentaly clicking something etc and will make it look like it's not opening any workbook.
Here's my approach (untested) assuming the workbook you want to copy data to is Workbooks("Report.xlsm").Worksheets(1):
Sub Pulsante1_Click()
'set workbook object for the destination workbook
set wb_dest = Workbooks("Report.xlsm").Worksheets(1)
'disable screen updating
Application.ScreenUpdating = False
For Each target_wb In Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'set wb object and open workbook
Set wb = Workbooks.Open(target_wb)
'find last row in this workbooks in columns A:B (whichever is greater)
LastRow = wb.Range("A:B").Find(What:="*", After:=wb.Range("A1"), SearchDirection:=xlPrevious).row
'copy required data
wb.Range("A1:B" & LastRow).Copy Destination:=wb_dest.Range("B1:C" & LastRow)
'fill column A with path to the file
wb_dest.Range("A1:A" & LastRow).Value = wb.Path
'close workbook
wb.Close False
Next
'enable screen updating
Application.ScreenUpdating = True
End Sub
Obviously an array is not the best approach if you have loads of different files, collection would be a lot clearer to read and edit in the future, unless you want to create a dynamic array, but there's no need for that in my opinion. I didn't declare variables or write any error handling, it's a simple code just to point you in the right direction.
If you want to disable workbook events or/and alerts, you can set Application.DisplayAlerts and Application.EnableEvents to False temporarily.
So I have an Excel file, that I want to export some of the rows to another Excel file, my problem is that I have a row that is like:
1
1
1
2
2
2
3
3
3
1
1
1
And I want to export from the first row with number one to the last row with number 3, and after exportation delete that same lines.
So far i have this.
Private Sub export2()
folha = exportform.Label14.Caption
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim src As Workbook
' ABRIR EXCEL
Set src = Workbooks.Open("U:\Mecânica\Produção\OEE\OEE ( FULL LOG )\FRS\FRS_DADOS.xlsx", True, False)
WS_Count = src.Worksheets.Count
For o = 1 To WS_Count
src.Worksheets(o).Unprotect password:="registoOEE"
Next o
lastsrc = src.Worksheets("DADOS").Range("A65536").End(xlUp).Row
last = Application.ThisWorkbook.Worksheets(folha).Range("A65536").End(xlUp).Row
Dim last, I As Integer
Dim turno As String
Sheets(folha).Select
For I = 2 To last
'If application.ThisWorkbook.Worksheets(folha).Cells(last, 61)
Next I
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
For o = 1 To WS_Count
src.Worksheets(o).Protect password:="registoOEE"
Next o
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
src.Save
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
' CLOSE THE SOURCE FILE.
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
fim:
End Sub
I've edited so you can see what code i have already, hope it helps.
Answering this 10 months old question as it might help someone who is still searching for similar kind of results.
I have put a count if formula in AI column to count the number of occurrences of value in AH and if the the AI value is greater than 1 the same will be pasted in different sheet.
Here is the code:
Sub CopyDups()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Dim cnt As Range
Dim nu As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("SourceData")
Set Target = ActiveWorkbook.Worksheets("Criteria 1")
nu = 1
For Each cnt In Source.Range("AI1:AI1000")
If cnt > 1 Then
Source.Rows(cnt.Row).Copy Target.Rows(nu)
nu = nu + 1
End If
Next cnt
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub