Data input on excel: form sheet to database sheet - excel

I'm using a dynamic button on one sheet to send data to a database/summary sheet within the same workbook in Excel.
I know I know. Should've done this using Access and queries, but I used the trusty brute-force method in the code shown below.
It works, but it's painstakingly slow. Please advise on how to perform this task with less demand on the processor.
'enter into database
NextSPGP.Value = Range("B7").Value
NextDate.Value = Format(Range("M7").Value, "mm/dd/yyyy")
NextStart.Value = Format(Range("A12").Value, "hh:mm")
NextFinish.Value = Format(Range("B12").Value, "hh:mm")
NextMix = Range("C12").Text
NextBatch.Value = Range("D12").Value
NextGrouter.Value = Range("J7").Value
NextPump.Value = Range("H7").Value
NextPass.Value = Range("F7").Value
NextDepth.Value = Range("E12").Value
NextSleeve.Value = Range("F12").Value
NextInitPress.Value = Range("G12").Value
NextFinalPress.Value = Range("H12").Value
NextFlow.Value = Range("I12").Value
NextVol.Value = Range("J12").Value
NextMove.Value = Range("K12").Value
NextComment.Value = Range("L12").Value

Instead of this
NextSPGP.Value = Range("B7").Value
NextDate.Value = Format(Range("M7").Value, "mm/dd/yyyy")
NextStart.Value = Format(Range("A12").Value, "hh:mm")
NextFinish.Value = Format(Range("B12").Value, "hh:mm")
NextMix = Range("C12").Text
NextBatch.Value = Range("D12").Value
NextGrouter.Value = Range("J7").Value
'etc...
You can do something like:
Dim Arr
Arr = Array(Range("B7").Value, Format(Range("M7").Value, "mm/dd/yyyy"), _
Format(Range("A12").Value, "hh:mm"),Format(Range("B12").Value, "hh:mm"), _
Range("C12").Text, Range("D12").Value, Range("J7").Value)
NextSPGP.Resize(1,UBound(Arr)+1).Value = Arr 'populate row in one shot

Tim Williams' suggestion with some minor editing. The database row had two cells needing data manipulation of a time (date) variable and pressure differential of initial to final pressures on our grout pumping operation. Success below:
MsgBox "Starting data input..."
enter log data into database
Dim NewData
Dim Duration As Date
Dim PressureDiff As Long
Duration = Format((Range("B12") - Range("A12")), "hh:mm")
PressureDiff = (Range("H12") - Range("G12"))
NewData = Array(Range("B7").Value, Format(Range("M7").Value, "mm/dd/yyyy"), Format(Range("A12").Value, "hh:mm"), _
Format(Range("B12").Value, "hh:mm"), Duration, Range("C12").Text, Range("D12").Value, Range("J7").Value, _
Range("H7").Value, Range("F7").Value, Range("E12").Value, Range("F12").Value, Range("G12").Value, _
Range("H12").Value, PressureDiff, Range("I12").Value, Range("J12").Value, Range("K12").Value, Range("L12").Value)
NextSPGP.Resize(1, UBound(NewData) + 1).Value = NewData
MsgBox "Data input complete!"

I usually start of my routines with something like this:
Dim bScreenUpdating As Boolean 'Screen Updating Flag
Dim bEnableEvents As Boolean
Dim lCalculation As Long
With Application
bScreenUpdating = .ScreenUpdating
bEnableEvents = .EnableEvents
lCalculation = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
...and end them with something like this:
With Application
.ScreenUpdating = bScreenUpdating
.EnableEvents = bEnableEvents
.Calculation = lCalculation
End With
...so that you turn things off that might slow progress, and restore the users environment afterwards.
Also, unless you have a reason to use .value, use .value2. See Excel MVP and Recalculation Guru Charles Williams' respone to the following thread:
What is the difference between .text, .value, and .value2?
Note that defining ranges in VBA code like you are doing is a recipe for disaster. As soon as someone inserts/deletes a row/column, all your VBA references are pointing at the wrong cells. I always give each of my ranges of interest a named range, and then reference that name in the VBA.
Also, you haven't given us much information about your workbook setup. How many values are we talking about here? Hundreds? Thousands? And is anything referencing the destination cells in the destination sheet? What else can you tell us about this workbook? i.e. is it a really big file with lots of formulas? What kinds of formulas? VLOOKUPS? OFFSET or other volatile functions? Are you writing these values into an Excel Table aka ListObject? These can really slow things down - particularly if you don't temporarily turn off calculation.

Related

VBA excel module works not always

Hello stackoverflow users,
I am facing the following problem, I receive a very big Excel table every day and would like to simplify it. So I decided to automatize this task, I wrote a VBA script and saved it as a module.
I open and execute it, sometimes it works. I am searching for hours already for any hint.
Function HideRows()
ActiveSheet.Rows("2:2").EntireRow.Hidden = True
ActiveSheet.Rows("5:5").EntireRow.Hidden = True
ActiveSheet.Rows("8:8").EntireRow.Hidden = True
ActiveSheet.Rows("10:10").EntireRow.Hidden = True
ActiveSheet.Rows("11:11").EntireRow.Hidden = True
ActiveSheet.Rows("24:24").EntireRow.Hidden = True
ActiveSheet.Rows("29:29").EntireRow.Hidden = True
ActiveSheet.Rows("30:30").EntireRow.Hidden = True
ActiveSheet.Rows("31:31").EntireRow.Hidden = True
ActiveSheet.Rows("37:37").EntireRow.Hidden = True
End Function
Function HideColumns()
Dim rng As Range
For Each rng In Range("C:J").Columns
rng.EntireColumn.Hidden = True
Next rng
For Each rng In Range("L:M").Columns
rng.EntireColumn.Hidden = True
Next rng
End Function
Function FilterByAttributes()
beginRow = 1
EndRow = Cells(Rows.Count, 1).End(xlUp).row
ActiveSheet.Range("K" & EndRow).AutoFilter Field:=11, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
End Function
Private Sub CommandButton1_Click()
Call HideColumns
Call HideRows
Call FilterByAttributes
End Sub
Is there any better possibility to format the table with less amount of clicks according to the conditions in my script?
UPDATE: the algorithm of my actions:
Download excel table from my email
Open this excel table
Open "Developer tools tab"->Visual Basic-> File-> Import->Select module->Execute Module. This step has to be somehow simplified, have no ideas how
Continue working with the resultant table
I would like to make as less clicks as possible for the "special filter"
Thanks in advance
Some thoughts:
1) Consider adding the macro to a personal workbook instead of importing it every day to a new excel file.
2) You don't need a loop to hide columns: ActiveSheet.Columns("C:J").Hidden = True, and similarly for .Columns("L:M").
3) The Call keyword can be dropped.
4) Add Option Explicit to the top of the module and declare all variables, specifically beginRow and EndRow.

Excel Macro to break out tabs to account specific workbooks

Sub CostCenterMarco2014()
Dim xlCalc As XlCalculation
Dim CC As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ccf As Range
Dim ccl As Range
Dim tt As Integer
On Error Resume Next
' Turn off events and screen updating
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set thisbook = ActiveWorkbook
' Iteration over SAP cost centers
For i = 2 To 30
CC = thisbook.Worksheets(1).Cells(i, 1).Value
thisbook.Worksheets("Summary").Range("B2").Value = CC
thisbook.Worksheets("Summary").Calculate
Workbooks.Add
thisbook.Worksheets("Summary").Range("A1:Z100").Copy
ActiveWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteFormats
ActiveWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("Sheet1").Columns("A:Z").AutoFit
' Iteration over 5 sheets
For j = 4 To 7
ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Worksheets
ActiveWorkbook.Worksheets(j).Name = thisbook.Worksheets(j).Name
'Copy header row
thisbook.Worksheets(j).Rows(1).Copy Destination:=ActiveWorkbook.Worksheets(j).Range("A1")
' Depending on the format of header row
'tt = ActiveWorkbook.Worksheets(j).Range("A1").CurrentRegion.Columns.Count
tt = ActiveWorkbook.Worksheets(j).Range("IV1").End(xlToLeft).Column
With thisbook.Worksheets(j)
Set ccf = .Range("A:A").Find(what:=CC, after:=.Cells(1, 1), LookIn:=xlValues, SearchDirection:=xlNext)
If Not ccf Is Nothing Then
Set ccl = .Range("A:A").FindPrevious(after:=ccf)
.Range(.Cells(ccf.Row, 1), .Cells(ccl.Row, tt)).Copy Destination:=ActiveWorkbook.Worksheets(j).Range("A2")
End If
End With
Application.CutCopyMode = False
ActiveWorkbook.Worksheets(j).Range("A1").CurrentRegion.Columns.AutoFit
thisbook.Worksheets(j).Range("A1").Select
Next j
ActiveWorkbook.Worksheets("Sheet1").Name = "Summary"
ActiveWorkbook.Worksheets("Sheet2").Delete
ActiveWorkbook.Worksheets("Sheet3").Delete
ActiveWorkbook.Worksheets("Summary").Select
ActiveWorkbook.Worksheets("Summary").Range("A1").Select
ActiveWorkbook.SaveAs Filename:="\\REDACTED\2.February 2019\Monthly Expense Report February 2019-" & CC '& ".xlsx"
ActiveWorkbook.Close
Next i
' Turn on events and screen updating
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = False
End With
On Error GoTo 0
End Sub
So I won't profess to knowing a whole lot about coding in general. I took a couple classes in college so I feel like I can at least feel my way through this one. This macro was given to me by someone who is no longer at my company. Most of it is working as intended and it worked completely last month.
This month however the Iteration over 5 sheets section just doesn't seem to be working. I tried to step through the macro and it creates a new workbook and pastes the summary info inside, but then when it gets to copying the tabs it doesn't copy any of the 4 details tabs I need or their name even.
What I end up with is all of the individual cost centers in their own file with summary as intended, but the detail tabs are not being copied. Any help is appreciated.
In this line
ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Worksheets
the after parameter is expecting a single sheet reference, not a reference to the entire Worksheets collection.
If, for example, you want to add a sheet to the end then you can use Count to locate the last sheet, using it as the sheet index:
ActiveWorkbook.Worksheets.Add _
after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
Remove On Error Resume Next unless, and until, the code is fully tested and working. Even then, this should be a last resort and used to circumvent a specific issue that can safely be ignored.
After removing the nasty error blocks I had to add (ActiveWorkbook.Worksheets.Count)as referenced above. After that I was getting an error at thisbook.Worksheets(j).Range("A1").Select which I solved by just deleting it since it didn't seem like it was needed. Everything seems to be working appropriately now. Thanks for all the help.

What's the VB.NET equivalent to Excel's Get & Transform function for Web sources?

I'm trying to duplicate Excel's Get & Transform functionality in a VB.NET script. I want to load each URL from a list, and do the equivalent of loading all tables, as you would when using Data->From Web.
To illustrate what I'm talking about, here are a few screenshots:
Create a new From Web query.
Then select all the tables found and Load.
I would like to end up with something like this collection in Queries & Connections:
The closest I've come is by creating a new QueryTable using the URL, and saving all tables.
Public Sub Main()
Dim URL As String = Dts.Variables("User::URL").Value.ToString()
Dim FileName As String = Dts.Variables("User::FileName").Value.ToString()
Dim xlNone As XlWebFormatting = XlWebFormatting.xlWebFormattingNone
Dim Format As XlFileFormat = XlFileFormat.xlCSVWindows
Dim ScrapeStatus As Integer = 1
Dim excel As New Microsoft.Office.Interop.Excel.ApplicationClass
With excel
.SheetsInNewWorkbook = 1
.DisplayAlerts = False
End With
Dim wb As Microsoft.Office.Interop.Excel.Workbook = excel.Workbooks.Add()
With wb
.Activate()
.Worksheets.Select(1)
End With
Try
Dim rnStart As Range = wb.ActiveSheet.Range("A1:Z100")
Dim qtQtrResults As QueryTable = wb.ActiveSheet.QueryTables.Add(Connection:="URL;" + URL, Destination:=rnStart)
With qtQtrResults
.BackgroundQuery = False
.WebFormatting = xlNone
.WebSelectionType = XlWebSelectionType.xlAllTables
.Refresh()
End With
excel.CalculateUntilAsyncQueriesDone()
wb.SaveAs(FileName)
wb.Close()
excel.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(excel)
GC.Collect()
GC.WaitForPendingFinalizers()
Dts.TaskResult = ScriptResults.Success
Catch ex As Exception
Dts.Variables("User::Error").Value = ex.Message.ToString()
wb.Saved = True
wb.Close()
excel.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(excel)
GC.Collect()
GC.WaitForPendingFinalizers()
Dts.TaskResult = ScriptResults.Failure
End Try
End Sub
This puts all the tables into a single sheet, and the .xlsx file ends up containing one Connection under Queries & Connections instead of N tables under the Queries tab.
So, is there a VB.NET equivalent to Excel's Data->From Web UI?
After extensive searching of various VB* documentation, I found that the functionality I'm looking for comes from the Power Query tool. Currently it only exists in VBA, starting with Excel 2016.
The collection Workbook.Queries contains WorkbookQuery objects that represent Power Query queries.

Excel VBA for loop causes 100% CPU

Application.ScreenUpdating = False
Dim r As Range
Dim a As Long
Set op = Worksheets("ZVCTOSTATUS")
Set CP = op.Columns("J")
Set CTO = op.Range("J1")
Set OD = op.Columns("G")
Set ZV = op.Columns("H")
op.Activate
fa = op.Range("J" & Rows.Count).End(xlUp).Row
Set r = op.Range("J2:J" & fa)
For Each C In r
CTO = CP.Cells(C.Row, 1).Value
If CTO = "FG BOOKED" Or CTO = "CLOSED" Then
ZV.Cells(C.Row, 1) = 0
ElseIf CTO = "NOT STARTED" Or CTO = "UNCONFIRMED" Then
ZV.Cells(C.Row, 1) = OD.Cells(C.Row, 1).Value
End If
Next C
I am using this code to go through my worksheet making a For loop to change value in Column H by referencing to Column J.
When this code is used on a standalone worksheet, it seems to work perfectly. But once I port it over to a much bigger file which has data connection, and I run this macro only individually, it causes my CPU to run at 100% and takes up to 10 minutes.
Does anyone know why this is happening?
To help your macro run smoother you can insert the below code before your main code (just below the sub) and right after your code (just before the end sub)
This will turn off screen updates, alerts, and set the calculation to manual so no formulas are updating until after the process has ran.
'Please Before Main Code'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
'Insert main code here'
'Place After Main code'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
It seems you fell in a trap which has the following features:
You are using a large excel file which is several MB in size
The excel document is full of formula and data connection
Additionally it might have pivot tables and charts
Calculation option for Formula is Automatic
Try this:
1. Go to formula tab
2. Click "Calculation Option"
3. Select "Manual"
Now execute the macro you have created. It should be good to go. Once the macro is executed. You can change the calculation option.
Note: You can control the calculation option problematically as well using below snippet:
Dim CalcMode As Long
' This will set the calculation mode to manual
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
<< Add your macro processing here >>
' Again switch back to the original calculation option
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
Excel tries to calculate the values (based on formula) everytime any cell is changed. This is done for the entire document for every cell updated by your macro. So, for large excel document, it causes high CPU consumption.
You are setting values of cells one at a time triggering a recalculation. The way to do this correctly is to read the columns into memory first, set the values and write the results with one operation.
Public Sub AnswerPost()
Dim r_status As Range, r_value As Range, r_calc As Range
Dim i As Long, n As Long
Dim op As Worksheet
Set op = Worksheets("ZVCTOSTATUS")
' Find the number of items on cell "J2" and below
n = Range(op.Range("J2"), op.Range("J2").End(xlDown)).Rows.Count
' Set the nĂ—1 range of cells under "J", "G" and "H" columns
Set r_status = op.Range("J2").Resize(n, 1)
Set r_value = op.Range("G2").Resize(n, 1)
Set r_calc = op.Range("H2").Resize(n, 1)
Dim x_status() As Variant, x_value() As Variant, x_calc() As Variant
' Read cells from the worksheet into memory arrays
x_status = r_status.Value2
x_value = r_value.Value2
x_calc = r_status.Value2
' Set values of x_calc based on x_status, row by row.
For i = 1 To n
Select Case x_status(i, 1)
Case "FG BOOKED", "CLOSED"
x_calc(i, 1) = 0#
Case "NOT STARTED", "UNCONFIRMED"
x_calc(i, 1) = x_value(i, 1)
End Select
Next i
' Write the resulting array back into the worksheet
r_calc.Value2 = x_calc
End Sub
Test case for above code

Getting "Expected =" when using Range().Replace()

I'm trying to create a dynamic workbook where I have two Workbooks: one that contains my VB code, and a second containing the Sheets.
As they drop down regions it will update the value depending on the Regions, then update the rest of the Cells.
Sub Retrieve_Sales()
Dim OldRegin As String // Range [support_NP_E10_T12_CP1a_T12-Regions.xlsx]Region 1'!$B$2
Dim NewRegion As String // drop down with Regions 1 - Regions 20
OldRegion = Range("F2").Select
NewRegion = Range("C4").Select
Application.StatusBar = "Retrieing data on" & NewRegion
Application.ScreenUpdating = False
Range("F2").Replace(OldRegion, NewRegion)
End Sub
I keep receiving Expected =. Am I suppose to wrap it to a variable?
You might have several issues.
First, for the Expected = message change the .Replace line to:
Range("F2").Replace OldRegion, NewRegion
For more details, see the answer here: https://stackoverflow.com/a/15519085/2258
Also, I expected you want the .Value of the Range, not the .Select
OldRegion = Range("F2").Value
NewRegion = Range("C4").Value

Resources