VBA - copy specific rows from one sheet into another sheet when user closes file - vba

I'm new to VBA and I'm struggling a lot with a file I want to build.
I have a main Sheet that in a simple way looks like this (starting at column B - A is an empty column):
main
This is a simplified version just for the example. The first table of the sheet varies from B13 to O92, the second varies from B104 to O114 but some of those rows might be empty.
My goal is to join rows with content from the first area with rows with content from the second area in a different sheet (Sheet1), add to the left a column with 1s and "Cell 0" (content of cell B1). Using the example, the result would be something like this:
Sheet1
Sheet1 will stay hidden as I'm using it as a source of information to a different file. In fact, I may not need the 1s column if I find a way to copy information in a different way - I'm doing it like this (wsSource is Sheet1):
lRow = wsSource.Columns("A").Find(1, SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole).Row
wsSource.Range("B1:N" & lRow).Copy
I was trying to do it so Sheet1 is "emptied" when the file is opened and edited when file is closed - so that if new rows are added or information updated, it gets into Sheet1 every time.
I've tried several stuff I found online but couldn't make it to work. My main problem is adding the specified rows one after the others but I'm also struggling to reset Sheet1 every time the file is opened and automatically running the macro when file is closed.
Any help would be really appreciated.

Hopefully this will get you started. Both subs need to be pasted in VBE under ThisWorkBook rather module or sheet(n).
The first sub will execute when the workbook is open.
Are you sure you want to clear your sheet under these circumstances?
You will never have access to your table (without workarounds) since it will clear when opening every time.
If this is what you need, see the below method to clear a dynamic range (Col A - D down to last cell used in Col A) on Sheet1 every time the workbook that houses this code is opened.
Private Sub Workbook_Open()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ClearRange As Range
Application.ScreenUpdating = False
With ws
.Visible = xlSheetVisible
.Range("A1:D" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
.Visible = xlSheetHidden
End With
Application.ScreenUpdating = True
End Sub
Next, the below sub will only execute before the book is closing. This is where the bulk of your code will go to build your table.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Visible = xlSheetVisible
'Code goes here
ThisWorkbook.Sheets(1).Visible = xlSheetHidden
Application.ScreenUpdating = True
End Sub
You will need to qualify your objects (Ranges, Cells, etc.) directly (which sheet) since the code will not be housed in a sheet. The first sub uses a With block to qualify ranges and the second sub directly qualifies all objects with ThisWorkbook.Sheets(1).
Lastly, I recommend writing your code to build your table inside a module (qualify ranges!) so you can test and debug without needing to close/open your book continuously. Once you have the code working in a module, you can copy and paste the code directly into the 2nd sub here and you are good to go!

Related

Mirroring Sheet1 to Sheet2 for Interior Color only, through VBA

I have a schedule showing a lot of information. I would like to condense this onto a second sheet that displays the fill color only and none of the values.
I want that any fill color changes are automatically copied from sheet1 to sheet2.
I want the code to work with a specific cell range as they differ from both sheets, (Sheet1 is "D8:QP27) & (Sheet2 is B3:QN22) and to get it to mirror at all.
Sheet1 showing all information
Sheet2 showing fill (Interior.Color)
It looks as if you also want to copy the borders (eg the diagonal border of column I), so I would suggest you use PasteSpecial with the option xlPasteFormats. See https://learn.microsoft.com/en-us/office/vba/api/excel.range.pastespecial
With ThisWorkbook
.Worksheets("Sheet1").Range("D8:QP27").Copy
.Worksheets("Sheet2").Range("B3:QN22").PasteSpecial xlPasteFormats
End With
Update: As you are looking for a trigger to copy the format automatically. First step is to create a subroutine:
Sub copyFormat()
Application.ScreenUpdating = False
With ThisWorkbook
.Worksheets("Sheet1").Range("D8:QP27").Copy
.Worksheets("Sheet2").Range("B3:QN22").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
Now you need to find a way to call the code, eg
o call the routine from the Worksheet_SelectionChange-event (drawback: as this is rather slow, it could annoy the user)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
copyFormat
End Sub
o Place a button on the sheet to call the routine.
o Use a Timer to call the routine every n seconds (see https://learn.microsoft.com/en-us/office/vba/api/excel.application.ontime). Plenty of examples on SO and elsewhere

ms-Excel Worksheet transfer between worksbooks and vlookup

I have a simple problem(at least seems to be) that I just cannot seem to be able to find a good solution to:
I have 4 workbooks, that all contain two of the exact worksheets(rest of the worksheets are unique for each workbook). I am storing these two worksheets in a seperate workbook(so 5th workbook). Out of these 2 worksheets, 1 of them is a Data sheet made up of many tables, which I do updates on and the other one is a sheet called V, which just uses some vlookup functions to bring up the related data from this Data sheet.
I am trying to find a way to be able to pass along this data sheet to each individual workbook, instead of editing the data sheet individually for each workbook(All 4 of them).
I was able to come up with the following macro, which checks if the sheet already exists and if it does it deletes it. Then it opens up location of the excel file, copies this worksheet to the workbook and therefore I have the most "updated" version of this data worksheet.
Sub UpdateT()
Sheets("data").Visible = True
Dim wb As Workbook
Dim aw As Workbook
''Open 2nd Workbook
Set aw = Application.ActiveWorkbook
'Check if data worksheet exists, and if it does delete it
If Not GetWorksheet("data") Is Nothing Then
Application.DisplayAlerts = False
Worksheets("data").Delete
Application.DisplayAlerts = True
End If
'Check if T worksheet exists, and if it does, delete it
If Not GetWorksheet("T") Is Nothing Then
Application.DisplayAlerts = False
Worksheets("T").Delete
Application.DisplayAlerts = True
End If
Set wb = Workbooks.Open(Filename:="C:\Users\yilmadu001\Desktop\Update.xlsx")
'Copy To Different Workbook
wb.Sheets("data").Copy _
After:=aw.Sheets("Data1")
wb.Sheets("5120 TI").Copy _
After:=aw.Sheets("MENU5120")
'Close 2nd Workbook
aw.Save
wb.Close
'Hide the data worksheet
aw.Sheets("data").Visible = False
End Sub
'Function to check if worksheets exist
Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function
The problem is the following:
When the new Data worksheet is transferred, the V worksheet is no longer working with the Vlookup function to be able to point to the relative information. So then I thought, okay what if I transfer BOTH Data and V worksheets, however that also did not work.
Is there a way to be able to use Vlookup, while copying the Data sheet? (The name is exactly the same I do not understand why it does not seem to be able to point to the cells of the table). It just looks blank, can't point to anything.
NOTE: I am not changing the format of the Data tables, basically just the values, so the format is the exactly the same.
It is probably important to note that the main excel workbooks(the 4) are in use 24/7, therefore I cannot go the other way(Update from Data workbook to the main workbook). I must "pull" the updated worksheet rather than "push".
If anyone has any suggestions I'd really appreciate. Thank you.

After data update, preserve cell values instead of formulas and delete data sheet

I have a xlsx spreadsheet with a bunch of sheets that either contain data or formulas. Lets say sheet1 has the data and sheet2 has formulas referring to the data in sheet1. I'm trying to do the following when sheet1 is updated with new data (coming from a SAS program):
convert sheet2 to only values (i.e. remove the formulas behind)
delete sheet1
save file
I would need to automate this througout the spreadsheet and have the macro/program run automaticcaly when there's an update.
So far, here's what I got (pasting values instead of formulas):
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("tab2")
ws.UsedRange.Value = ws.UsedRange.Value
End Sub
I am really not familiar with VBA.
You've got the values only in Sheet2.
You want to delete Sheet1 (there should be a pop-up to check if you really want to delete the sheet... we're going to turn that off before you do, then back on after):
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Then to .SaveAs (prompts for file name to save as)
ThisWorkbook.SaveAs Filename:=fName
Try this:
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("tab2")
ws.UsedRange.Value = ws.UsedRange.Value
Application.DisplayAlerts = False
Sheets("sheet1").Delete
Application.DisplayAlerts = True
ActiveWorkbook.Save
End Sub
Why not just scratch the idea of two sheets and extrapolate on the answer I got in my question.
Use formula to update cells, but as values
Try a macro with
Range("A1:P10").Select
With Selection
.Value = .Value
End With
This will turn every formula in the range you've selected into it's value. Just don't try using Cells.Select. When I tried it, I got a memory related error. If your spreadsheets are various sizes, then calculate the bottom cell first.
Sub Convert()
' Table Bottom
Dim TB As Long
' Set Table Bottom Variable
TB = Range("A65000").End(xlUp).Row 'finds bottom row
' Change Formulas in Range to Values
Range("A1:P" & TB).Select
With Selection
.Value = .Value
End With
End Sub
Sometimes I have to change the column for finding the bottom row depending on the spreadsheet, but this is the general idea.
I think this will accomplish what you're ultimately trying to do if you put this at the end of the code that is pulling the updates, or if you just run it separately after the updates have been completed. It doesn't seem like your goal is to have two different spreadsheets. Just one spreadsheet that is only values.

How to copy a row of data from one sheet to another based on cell data

I'm using excel for a project management tool. Right now I have a large table with a series of drop down menus for users to select who is responsible for the project, due dates, etc.
What I'd like to be able to do is copy over the full row (all project data) to each user individual page.
Say "Fred" creates a project and assigns it to "Tom" on the master page, I want Tom's sheet to autopopulate with the project details so instead of scrolling through the list to find him own name, he can click on his tab at the bottom of the master list and see all of his projects.
I've read through several questions somewhat similar and have yet to find anything that works.
For reference, the names are all in column F and there are currently 12 names that user can select from to assign a project; therefore, there are also 12 blank pages/sheets tabbed at the bottom next to the master page tab.
Thanks for any help you may be able to offer!
This macro might work for you - you need to put the right column number in for the filter...
It has to be put in the "Workbook" code (not a module - otherwise the event handling won't work).
It will run every time you change sheets - and will copy the most up to date information into the project leader's tab. If you have "other" sheets that you don't want this to act upon, you must catch the names of those sheets in the same line where code currently tests for "Master".
Changes needed to adapt to your specific situation - I'm sure you can handle it.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim prjLeader As String
Dim wholeRange As Range
prjLeader = Sh.Name
If prjLeader = "Master" Then Exit Sub ' whatever the name of the master sheet is...
On Error GoTo outtahere
Application.EnableEvents = False
Application.ScreenUpdating = False
Sh.UsedRange.Clear ' remove "old" information
ActiveWorkbook.Sheets("Master").Activate
Set wholeRange = ActiveSheet.UsedRange
wholeRange.AutoFilter Field:=6, Criteria1:=prjLeader ' use the field where proj leader name is (F = 6)
wholeRange.Copy ' copy all filtered data
Sh.Activate ' and paste it in project leader's sheet
Range("A1").PasteSpecial
outtahere: ' handle errors - back to sheet, turn events back on
Sh.Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

VB Compare two range of cells in multiple workbooks and if match copy to different cell

I am trying to figure this out all day. This is what I need to accomplish:
Using GetFile select a number of workbooks without opening them.
Compare Cell A2 of selected workbooks indiviually in loop to a reference workbook.
If Cell A2 of the selected workbook equals the numerical value of the numerical value within the reference workbook contained within column A then copy/past column B's text in the corresponding cell of the matched reference workbook cell to M2 of the selected workbook.
Sounds complicated but let me demonstrate. The letters represent column names.
Selected Workbook
A2=12 M2= ""
Reference Workbook
A2=12 B2=milk, protein
Desired result:
Selected Workbook
A2=12 M2=milk, protein
So far this is the code I have:
Sub Click()
Dim rCell As Range, vVal1, vVal2
Dim wbCheck As Workbook
For Each rCell In Workbooks("2.xls").Worksheets(1).Range("A1:C100")
vVal1 = rCell
vVal2 = ThisWorkbook.Worksheets(1).Range(rCell.Address)
If IsNumeric(vVal1) And IsNumeric(vVal1) Then
If vVal1 = vVal2 Then
rCell.Interior.ColorIndex = 3
ElseIf vVal1 < > vVal2 Then
End If
End If
Next rCell
End Sub
Why do you need a VBA code for this?
This can be achieved using an Excel Formula.
Paste this in M2 and copy it down
=IF(A2='C:\[Ref.xlsx]Sheet1'!A2,'C:\[Ref.xlsx]Sheet1'!B2,"")
My Assumptions (Please change as applicable)
The reference file name is Ref.xlsx
You are pulling data from Sheet1 of reference file
The Ref.xlsx is in C:
EDIT
Even if you want to use VBA, you can also do this.
Sub Sample()
Application.Calculation = xlCalculationManual
ThisWorkbook.Sheets("Sheet1").Range("M2").Formula = _
"=IF(A2='C:\[Sample.xlsx]Sheet1'!A2,'C:\[Sample.xlsx]Sheet1'!B2,"""")"
Application.Calculation = xlCalculationAutomatic
End Sub
The above formula or code is beneficial becuase of what you mentioned in 1st point Using GetFile select a number of workbooks without opening them. If you do not want to open the file then the formula or formula in VBA is the way to go :)
I solved my own question. The answer was to use VLookup.
=VLOOKUP(I2, 'C:\Desktop\Merge[ISReference.xlsx]Reference'!B2:G1923, 6, FALSE)
I am surprised no one suggested this to me. Given its simplicity I was able to build this function into some code I built to run through a FSO filedialog picker on a form in access and link external workbooks with Vlookup.
Thanks Siddarth for giving the proper direction of embedding a function instead of crazy iterated loop.