Refreshing Tables with VBA - vba

I have two tables, one with a list of cities( we'll call this City List), and another with data points that correspond with those cities ( Call this The Data Table). The Data Table, is connected to a Select query that I built in MS SQL Server. This Select query/ Data Table has a single Where clause in which I have substituted the SQL criteria and replaced a ? in order to make it a parameter when connected to Excel.
Now that I have that out of the way, I'll explain what I'm trying to accomplish. I want to loop through the City List and for each city in the list, update The Data Table to reflect the data points for the city. Ultimately, I would like to loop through and each time The Data Table is refreshed, it saves a copy of the workbook with that specific table.
I have posted my current code down below, but my issue is that the table never refreshes with the current data that corresponds with the city that is currently selected via the loop. With that being said, if I hit the escape key to break out of the VBA macro, the table will then refresh with whatever the last city was before I stopped the macro.
Code:
Sub Macro1()
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim CT As Variant
Dim MSG As String
Set WS = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")
CT = Range("A1").CurrentRegion
For i = 2 To UBound(CT, 1)
MSG = ""
For J = 1 To UBound(CT, 2)
WS.Range("$D$2").Value = CT(i, J) //Places the city into Cell $D$2 which is where The Data Table looks to for the parameter.
Exit For
Next J
ActiveWorkbook.Connections("Query from Database").Refresh
WS2.ListObjects(1).Refresh
Next i
End Sub
It's almost as though the macro is running too fast for the table to catch up and refresh. I've tried adding some wait times into the code, in hopes that it would give it enough time to allow the table to refresh, but that had no affect. I have also turned off Background Refresh, and that doesn't seem to do anything either. Right now it just loops through the city table, and with each city it shows that the query is refreshing, but after the query is finished refreshing, it goes onto the next city without ever updating The Data Table. HELP!

There are a couple of things I think you need to do -- maybe you've already done them.
When you set up your parameter/bind variable (which you have done), point it to a specific cell. Then, within your SQL Server query, make sure the parameter is bound to that range every time:
Forgive me if I'm overstating the obvious, but for those that don't know you get to this dialog by right-clicking the table and selecting Table->Parameters.
From there, as you iterate through your main table (the one with the cities in it), you can just take the value from each row in that table and update the cell with the binding parameter.
Something like this should work:
Sub RefreshAllCities()
Dim ws1, ws2 As Worksheet
Dim loCities, loDataTable As ListObject
Dim lr As ListRow
Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
Set ws2 = ActiveWorkbook.Worksheets("Sheet2")
Set loCities = ws1.ListObjects("CityList")
Set loDataTable = ws2.ListObjects("DataTable")
' get rid of those pesky warnings to overwrite files
Application.DisplayAlerts = False
For Each lr In loCities.ListRows
ws2.Cells(1, 2).Value = lr.Range(1, 1).Value
loDataTable.QueryTable.Refresh BackgroundQuery:=False
ActiveWorkbook.SaveAs Filename:="C:\temp\" & lr.Range(1, 1).Value & ".xlsx", _
FileFormat:= xlOpenXMLWorkbook
Next lr
Application.DisplayAlerts = True
End Sub
I assume you wanted .xlsx files in this example. This will clobber any embedded VBA, which is actually a nice bonus, as the recipients of the filtered datasets won't have to be exposed to that. If you want xlsm or xlsb, that's easy enough to change.

By default Excel will "Enable Background Refresh" which will allow Excel to move on and continue execution before the query refresh is actually finished. Some people have been able to get it to work by calling .Refresh twice but it's pretty much random/arbitrary timing.
There should be an Excel option to uncheck in the Data Tables properties or you might be able to update the BackgroundQuery = False property from VBA through a reference to it
If you disable background refreshing then your code will sit and wait for the refresh to complete before moving on.

Related

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

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!

Copying only unique values from one table to another moves over some duplicates

So, I have a "narrow" table that I'm trying to turn into a "Wide" table. Alrighty, off to VBA we go to get this done in a reasonable amount of time. Let's get our keyID moved over first, and we only need unique values moved over. The code:
Sub Flatten()
Dim RawTable As ListObject
Dim FlatTable As ListObject
Dim SWS As Worksheet ' Source worksheet
Dim DWS As Worksheet ' Destination worksheet
Dim wb As Workbook
Dim HeaderCheck As Boolean
Dim FlatLastRow As Long
Dim MoveRange As Range
Dim LastColFlat As Long
Set wb = ThisWorkbook
Set SWS = wb.Sheets("RawData")
Set DWS = wb.Sheets("Flattened Data")
HeaderCheck = wb.Names("HeaderIntegrityCheck").RefersToRange.Value2
If HeaderCheck Then
'Everything's good
Else
'Problem
MsgBox "Bad data entered into the RawData tab, headers aren't as expected. Please fix. The macro will now end"
End
End If
Set RawTable = SWS.ListObjects("RawTable")
Set FlatTable = DWS.ListObjects("FlatTable")
Set MoveRange = RawTable.ListColumns(3).DataBodyRange
LastColFlat = DWS.Cells(1, Columns.Count).End(xlToLeft).Column
FlatTable.Resize FlatTable.Range.Resize(CountUnique(MoveRange) + 1, LastColFlat)
MoveRange.AdvancedFilter Action:=xlFilterCopy, copytorange:=FlatTable.ListColumns(2).DataBodyRange, unique:=True
End Sub
The issue: The first two ID's will duplicate/not be unique. For example, 2155904666, 2155904666, 2155904659, 2155904659; will move over 2155904666, 2155904666, 2155904659. If I reverse it, I get 2155904659, 2155904659, 2155904666. This is happening with tiny datasets, with large datasets - the first two are always moving over. This also causes an error to trigger, since it properly counts how many unique IDs there are, and then tries to put one more line into the table.
Hack to fix: Have the resize be +2, test if the 1st data line is the same as the 2nd dataline, remove one of the lines if they are duplicates, then resize back down. This works, but it's clumsy and inelegant, and doesn't address the root cause of why moving over the values as unique isn't moving them over uniquely.
PS: If anyone has a better unique move method I'm all ears. Microsoft scripting library required to make the code run.

Excel 2013: Use macro to copy and subsequently add data from one sheet to another within same workbook

I have used the various methods pointed out in this forum and none seem to work, so I will try to be more specific.
I have a workbook called LIBRARY.xlsm.
This workbook contains two worksheets: CALCULATOR and CUTS.
The worksheet CALCULATOR contains two tables: INPUT and OUTPUT.
I enter data into INPUT, values are calculated and automatically entered into OUTPUT.
I create a button below OUTPUT with macro to copy data in OUTPUT to worksheet CUTS.
I enter new data into INPUT, which then updates OUTPUT.
Now I want to copy this new data to CUTS without overwriting or deleting previous data.
Since this project is divided into 5 sections, I should end up with five tables in the worksheet CUTS that I can then print out.
The INPUT table encompasses cells A1:M31, which does not matter (I’m not copying this).
The OUTPUT table occupies cells O6:S26. This is the data that needs to be copied.
Placement into worksheet CUTS can start at cell A1 (which means the table will have the range A1:E20). I would like to skip a column and then place the next data set. Thus, the next data set should begin at G1 (G1:K20), then at M1:Q20 and so forth). Maybe only go three tables across and then start next three below (separated by row).
Here is the code tried to use. Problem is, it does not retain the values and it overwrites the previous data.
Sub Create_CUTS ()
Dim sourceSheet As Worksheet
Dim sourceRange As Range
Dim sourceRows As Integer
Set sourceSheet = Worksheets("CALCULATOR")
sourceRows = WorksheetFunction.CountA(sourceSheet.Range("A:A"))
Set sourceRange = sourceSheet.Range("O6:S26" & sourceRows)
Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetRows As Integer
Set targetSheet = Worksheets("CUTS")
targetRows = WorksheetFunction.CountA(targetSheet.Range("A:A"))
Set targetRange = targetSheet.Range("A" & targetRows + 1 & ":A" & targetRows + 1 + sourceRows)
sourceRange.Copy Destination:=targetRange
End Sub
Thank you, everyone
-Grumps
There are a few ways to do this. The easiest is probably to just reference the usedrange of the target sheet to know where you left off with the last paste.
lastUsedRow = targetSheet.UsedRange.Rows.Count
lastColumnUsed = targetSheet.UsedRange.Columns.Count
Then you just add a column or row and paste the table in the new location. If the column count is 22 or greater, add a row and paste at "A" and the lastUsedRow + 2. There is some potential for this to be wrong if the sheets are saved with cells that are empty, but excel reads them as "used" (somehow people I work with manage to do this all the time, I don't even know how they do it). It sounds like this is something that users won't be manipulating, so I wouldn't think that would be a problem, but if it is a possible problem for you, you can use a loop to find the next empty cell instead of using the built in "usedrange" collection.

Condense largely(Unpractical) loop based VBA code; nested For...Next loops

Hello everyone alright let start by giving some brief background on my project then I will follow up with my specific issue and code.
Currently I am building a program to automate the process of filling a template. This template exceeds 60,000 rows of data quite often and I've built the large majority of it to work month to month by plugging in new data sheets and running it. Currently all of the work is based off of one data sheet which I import into excel manually. This data sheet does not contain all the data I need to populate the template so now I am beginning to bring in additional data to supplement this. The problem herein lies with data association. When I was originally pulling from one data sheet I didn't have to worry if the data I pulled for each row coincided with the other rows because it all came from the same sheet. Now I have to cross check data across two sheets to confirm it is pulling the correct information.
Now for what you need to know. I am trying to fill a column that will be referred to as Haircut, but before I do that I need to confirm that I am pulling the correct haircut number in correlation to a Trade ID which was already populated into the template in a previous line of code.
Using similar logic that I have been using throughout my entire project this is a snippet of code I have to perform this task.
Dim anvil as Worksheet
Dim ALLCs as worksheet
Dim DS as worksheet
'''''''''''''''''''''''''''''code above this line is irrelevant to answer this question
ElseIf InStr(1, DS.Cells(x, 2), "Haircut") Then
Anvil.Select
For y = 1 To 80
If Anvil.Cells(1, y) = "Haircut" Then
For Z = 1 To 80
If Anvil.Cells(1, Z) = "Trade ID" Then
For t = 2 To 70000
For u = 16 To 70000
If Anvil.Cells(t, Z) = ALLCs.Cells(u, 34) Then
ALLCs.Cells(u, 27) = Anvil.Cells(t, y)
End If
Next
Next
End If
Next
End If
Next
This code coupled with my other code I assume will in theory work, but I can only imagine that it will take an unbelievable amount of time(this program already takes 7 and a half minutes to run). Any suggestions on how to rewrite this code with better functionality, following this general logic?
Any help is appreciated, whether you completely revamp the code, or if you offer suggestions on how to cut down loops. I am also looking for suggestions to speed up the code in general aside from screen updating and calculation suggestions.
If I understand the logic correctly then you can replace all but one of the loops with a .Find() method like so:
'// Dimension range objects for use
Dim hdHaricut As Excel.Range
Dim hdTradeID As Excel.Range
Dim foundRng As Excel.Range
With Anvil
With .Range("A1:A80") '// Range containing headers
'// Find the cell within the above range that contains a certain string, if it exists set the Range variable to be that cell.
Set hdHaircut = .Find(What:="Haircut", LookAt:=xlWhole)
Set hdTradeID = .Find(What:="Trade ID", LookAt:=xlWhole)
End With
'// Only if BOTH of the above range objects were found, will the following block be executed.
If Not hdHaricut Is Nothing And Not hdTradeID Is Nothing Then
For t = 2 To 70000
'// Using the .Column property of the hdTradeID range, we can see if the value of Cells(t, hdTradeColumn) exists
'// in the other sheet by using another .Find() method.
Set foundRng = ALLCs.Range(ALLCs.Cells(16, 34), ALLCs.Cells(70000, 34)).Find(What:=.Cells(t, hdTradeID.Column).Value, LookAt:=xlWhole)
'// If it exists, then pass that value to another cell on the same row
If Not foundRng Is Nothing Then ALLCs.Cells(foundRng.Row, 27).Value = .Cells(t, hdHaircut.Column).Value
'// Clear the foundRng variable from memory to ensure it isn't mistaken for a match in the next iteration.
Set foundRng = Nothing
Next
End If
End With

How to conditionally copy and paste a from a table in one workbook to a table in another workbook in VBA

Although I am relatively seasoned excel user, I am fairly new to VBA and am trying to tackle a fairly complicated task (at least it's complicated to me).
I have data in tables in 5 workbooks that I am trying to aggregate into one master workbook. However, I don't want all of the data. I only want to pull the data ( about 6 columns worth) that failed one of the tests (cell reads: "Fail"). All of the source workbooks have the 6 columns in the same order and have say "Pass" or "Fail" in their own cells. I want to pull only the fails from each and paste into a master workbook. I would also like it to pull into a clean looking table (i.e no blank rows between each set of data).
I believe this is feasible, but it's above my skill level (right now). After hours and hours of research and trial and error that inevitably always ends in failure, I am about to wave the white flag. This is my last hope. Please help!
The approach would be to:
Open all the workbooks to merge (assumed to be done manually, but could be coded if required)
Get a reference to the Master Table
Loop through open workbooks
Find the Table in the current workbook (code below assumes onlt one Table in each book. IOf this is not the case, then it can be changed to use some distingusing feature of the required table)
Use AutoFilter to filter for "Fail" records.
Copy and Paste the data onto the end of the Master Table
This code demonstrates how to do this. You will need to adapt it to tour specific situation.
Place this code in a Module in the Master workbook.
Sub Demo()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim loMaster As ListObject
'Get Reference to Master table
Set loMaster = ThisWorkbook.Worksheets("Master").ListObjects(1)
' Loop through open workbooks
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
' Assumes only one Table in each workbook,
' so return the first one found
Set lo = Nothing
For Each ws In wb.Worksheets
If ws.ListObjects.Count > 0 Then
Set lo = ws.ListObjects(1)
Exit For
End If
Next
If Not lo Is Nothing Then
' Filter Table on column Result for Fail
lo.Range.AutoFilter _
Field:=lo.ListColumns("Result").Index, _
Criteria1:="Fail"
' Copy filterd data to Master Table
If loMaster.InsertRowRange Is Nothing Then
'Master table is not empty
lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
loMaster.DataBodyRange.Cells(loMaster.DataBodyRange.Rows.Count + 1, 1)
Else
'Master table is empty
lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
loMaster.InsertRowRange
End If
' Reset Autofilter
lo.Range.AutoFilter
End If
End If
Next
End Sub