Excel VBA - hide rows on sheet load - excel

In the interest of clarity, I've wiped the original question and am re-posting.
Scenario:
Source workbook has multiple pages, front page of book has a query/extract function to create a new book with some pre-entered data using a template from one of the sheets in the source book.
Requirements:
Phase 1: Extract function needs to set all rows beyond row 6 as hidden where the data in column A = HC.
First (and so far working) draft of that code as follows:
Sub Extract()
Dim wbkOriginal As Workbook
Set wbkOriginal = ActiveWorkbook
'sets site name and site ID into the estate page to be extracted
Worksheets(Sheet11.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6")
Worksheets(Sheet11.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6")
Worksheets(Sheet11.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6")
'hiding all rows that being with HC apart from row 6 which is the starting row
'code to be added to the individual estate sheets to unhide each row after status column filled
'on a row by row basis - as the hiding is for HC rows only, the section headers will remain visible
'may have to code around that on the sheet itself
BeginRow = 7
EndRow = 300
ChkCol = 1
For RowCnt = BeginRow To EndRow
If Worksheets(Sheet11.CmbSheet.Value).Cells(RowCnt, ChkCol).Value Like "HC" Then
Worksheets(Sheet11.CmbSheet.Value).Cells(RowCnt, ChkCol).EntireRow.Hidden = True
End If
Next RowCnt
' copies sheet name from combo box into new document, saves it with site name,
' site id and current date into user profile desktop folder for ease of access
' with new HEAT, worth investigating if sheet can be saved directly to a call ID folder?
With ActiveWorkbook.Sheets(Sheet11.CmbSheet.Value)
.Copy
ActiveWorkbook.SaveAs _
"C:\temp\" _
& .Cells(3, 2).Text _
& " " _
& Format(Now(), "DD-MM-YY") _
& ".xlsm", _
xlOpenXMLWorkbookMacroEnabled, , , , False
End With
'code to close the original workbook to prevent accidental changes etc
Application.DisplayAlerts = False
wbkOriginal.Close
Application.DisplayAlerts = True
End Sub
Phase 2: Each row that starts with HC, has a drop down in column E. That drop down has 3 options, 'Complete' 'Incomplete' and 'Not Required'
Task: When the user selects and clicks on an entry, the sheet needs to do the following
Unhide the next row
Enter the current windows username into column I
Enter the current time into column J
Prototype code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ChangedCell As Object
Dim lRow As Long
For Each ChangedCell In Target
If ChangedCell.Column = 5 And ChangedCell <> "" Then
lRow = ChangedCell.Row + 1
lRow.Hidden = False
Cells(lRow, 8) = Environ("USERNAME")
Cells(lRow, 9) = "HH:MM"
End If
Next
End Sub
Problem:
Compile error: Invalid Qualifier, referring to the lRow.Hidden = False line,
Tried to declare it as an object instead, thinking that would allow me to spec it that way instead, but no joy to be had.
As ever, any guidance from the community would be greatly appreciated.
Many thanks.
Rob.

Sub Extract()
Dim wbkOriginal As Workbook
Set wbkOriginal = ActiveWorkbook
'sets site name and site ID into the estate page to be extracted
Worksheets(Sheet11.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6")
Worksheets(Sheet11.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6")
Worksheets(Sheet11.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6")
'hiding all rows that being with HC apart from row 6 which is the starting row
'code to be added to the individual estate sheets to unhide each row after status column filled
'on a row by row basis - as the hiding is for HC rows only, the section headers will remain visible
'may have to code around that on the sheet itself
BeginRow = 7
EndRow = 300
ChkCol = 1
For RowCnt = BeginRow To EndRow
If Worksheets(Sheet11.CmbSheet.Value).Cells(RowCnt, ChkCol).Value <> "" Then
Worksheets(Sheet11.CmbSheet.Value).Cells(RowCnt, ChkCol).EntireRow.Hidden = True
End If
Next RowCnt
' copies sheet name from combo box into new document, saves it with site name,
' site id and current date into user profile desktop folder for ease of access
' with new HEAT, worth investigating if sheet can be saved directly to a call ID folder?
With ActiveWorkbook.Sheets(Sheet11.CmbSheet.Value)
.Copy
ActiveWorkbook.SaveAs _
"C:\temp\" _
& .Cells(3, 2).Text _
& " " _
& Format(Now(), "DD-MM-YY") _
& ".xlsm", _
xlOpenXMLWorkbookMacroEnabled, , , , False
End With
'code to close the original workbook to prevent accidental changes etc
Application.DisplayAlerts = False
wbkOriginal.Close
Application.DisplayAlerts = True
End Sub

Related

Save new workbook with data from multiple sheets

I am fairly new at using VBA to manipulate data in Excel. I am trying to build about 800 bills of materials from data I have extracted from an old system we are replacing.
I have an Excel workbook with multiple sheets with a table on each sheet. What I need to do is work through every "ParentID" in one sheet and save each unique "Parent ID" and "ChildID" to a new workbook titled with the ParentID. Then lookup each unique "ChildID" in another worksheet and save data from this worksheet to the new workbook for each unique "ChildID".
I found the below VBA code and have been working on changing things to work for me as I think this will get me at least part way there but I am having trouble getting all of the Template values replaced with my values due to lack of knowlege on syntax and VBA code.
If someone could help me identify what I need to replace to get at least this code working I think I would be well on my way.
Thanks!
Option Explicit
Sub ExportData()
'Declare variables
Dim ArrayItem As Long
Dim tblUsedIn As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range
'Set the worksheet to
Set tblUsedIn = Sheets("tblUsedIn")
'Set the save path for the files created
SavePath = Range("File Save Location")
'Set variables for the column we want to separate data based on
ColumnHeadingInt = WorksheetFunction.Match(Range("ParentID").Value, Range("Data[#Headers]"), 0)
ColumnHeadingStr = "Data[[#All],[" & Range("ParentID").Value & "]]"
'Turn off screen updating to save runtime
Application.ScreenUpdating = False
'Create a temporary list of unique values from the column we want to
'separate our data based on
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("UniqueValues"), Unique:=True
'Sort our temporary list of unique values
tblUsedIn.Range("UniqueValues").EntireColumn.Sort Key1:=tblUsedIn.Range("UniqueValues").Offset(1, 0), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Add unique field values into an array
'ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(tblUsedIn.Range("IV2:IV" & RotblUsedIn.Count).SpecialCells(xlCellTypeConstants))
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(tblUsedIn.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))
'Delete the temporary values
tblUsedIn.Range("UniqueValues").EntireColumn.Clear
'Loop through our array of unique field values, copy paste into new workbooks and save
For ArrayItem = 1 To UBound(ArrayOfUniqueValues)
tblUsedIn.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
tblUsedIn.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & Format(Now(), " YYYY-MM-DD hhmmss") & ".xlsx", 51
ActiveWorkbook.Close False
tblUsedIn.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem
tblUsedIn.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True
End Sub

Extract specific columns into multiple .CSVs, error in code

I have an excel file where each column has varying products codes, descriptions, unit of measure, and 5 different prices (one for each distributor) in this order.
Workbook as it is:
I need to make 5 distinct .csv files, named after each distributor, each with code, discount (normally 0), one of the prices, MU and description, in this order.
What one of the CSVs should look like:
I can move columns around alright, the issues is that I can't seem to find a way to save the CSVs.
The code that I have (not mine) stops as it seems to be "unable to access the .csv" as it tries to save it.
Sub FornitoriToCSV()
Const FLDR = "C:\Users\HER-XV\Desktop" 'where to save files
Dim rng As Range, wb As Workbook, i As Long, rws As Long
Set rng = ActiveSheet.Range("A1").CurrentRegion 'data table
rws = rng.Rows.Count 'how many rows of data?
For i = 4 To rng.Columns.Count 'loop for each client column (starting at col4)
Set wb = Workbooks.Add 'add workbook
'copy data to workbook
With wb.Sheets(1)
.Range("A1").Resize(rws).Value = rng.Columns(1).Value
.Range("B1").Value = "Discount"
.Range("B2").Resize(rws - 1).Value = 0
.Range("C1").Resize(rws).Value = rng.Columns(i).Value 'client data
.Range("D1").Resize(rws).Value = rng.Columns(3).Value
.Range("E1").Resize(rws).Value = rng.Columns(2).Value
End With
'save the file using the client name
wb.SaveAs Filename:=FLDR & rng.Cells(1, i).Value & ".csv", _
FileFormat:=xlCSVUTF8, CreateBackup:=False
wb.Close False
Next i
End Sub
Any help would be much appreciated!

Why Does this Macro Keep Deleting ALL of the Data

I have this Macro that copies one sheet from another Workbook that i open via a File Dialog. It is supposed to sort and delete the Rows whose A Column does not possess data in an Array I've defined. It appears to be copying and pasting the data properly but when it runs through the loop to delete the data that doesn't contain the items in the array it ends up clearing the entire sheet
This Macro worked last Friday when I left for the day but now it seems it no longer works. I've tried stepping through the code but the loop doesn't appear to change much so I'm unsure why it stopped working over the weekend.
Public filepath As String
Sub SPOMacro()
'Display a Dialog Box that allows to select a single file.
'The path for the file picked will be stored in fullpath variable
With Application.FileDialog(msoFileDialogFilePicker)
'Makes sure the user can select only one file
.AllowMultiSelect = False
'Filter to just the following types of files to narrow down selection options
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
'Show the dialog box
.Show
'Store in fullpath variable
fullPath = .SelectedItems.Item(1)
End With
filepath = fullPath
'It's a good idea to still check if the file type selected is accurate.
'Quit the procedure if the user didn't select the type of file we need.
If InStr(fullPath, ".xls") = 0 Then
Exit Sub
End If
'Open the file selected by the user
'Workbooks.Open fullpath
'This is the Copy Sheet Portion
'MsgBox filepath
Dim spo_book As Workbook
Dim target_book As Workbook
Set spo_book = Workbooks("SPO_Untimed_Report.xlsm")
Set target_book = Workbooks.Open(filepath)
Dim dst_sheet As Worksheet
Dim target_sheet As Worksheet
Set dst_sheet = spo_book.Sheets("SPO Data")
Set target_sheet = target_book.Sheets("Untimed Parts")
dst_sheet.Cells.Clear
dst_sheet.Cells.Delete
Z = Cells(Sheets("Untimed Parts").Rows.Count, 1).End(xlUp).Row
target_sheet.Range("A1:R" & Z).Copy
dst_sheet.Range("A1").PasteSpecial
' Sort Pasted Data by Cost Ctr
Dim dontDelete
dontDelete = Array("RX01225", "RX01303", "RX01304", "RX01314", "RX01338", "Cost Ctr")
dst_sheet.Activate
Dim i As Long, j As Long
Dim isThere As Boolean
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
For j = LBound(dontDelete) To UBound(dontDelete)
If StrComp(Range("A" & i), dontDelete(j), vbTextCompare) = 0 Then
isThere = True
End If
Next j
If Not isThere Then
Range("A" & i).Delete shift:=xlUp
End If
isThere = False
Next i
'Deletes Blank Rows
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
The expected outcome is that the workbook that I called SPO Untimed will keep the sheet called SPO Data and the data that is pasted into that sheet from the Selected Workbook (By the File Dialog) is sorted by the Array I've defined and only the rows that have those items in the A Column remain.

VBA: How to choose files from a folder based on a precondition loop in same sub?

I am very new to VBA and I am trying to automate a dashboard process for my team. The dashboard takes two raw data files, I call these raw data and OP. I created a sheet with macro where I paste the raw data and run the macro by help of button. It filters data based on column 'Market', and there are some 14 markets, start the loop and repeat for all 14. So raw data is one big file with all markets and OP are 14 specific to markets, these are too heavy files.
What I am trying to do is to pick the OP file from the folder for same market as that which the loop picking in raw data file. So trying to get 14 output files for each market.
I looked everywhere no solution. Any help will be a great help.
'Initialize Values
Dim wb_RawData As String
Dim wb_MasterData As String
Dim wb_Control As String
Dim wb_OP As String
Dim Tempsheet As String
Dim MarketArray As Variant
Dim MarketColumn As Integer
Dim Lastrow As Long
Dim ArrayLength As Integer
Dim Workbook As String
Dim StartTime As Double
Dim EndTime As Double
'Loop start time
StartTime = Now
wb_RawData = "RawData"
wb_MasterData = "MasterData"
wb_Control = "Control"
wb_OP = "OP"
MarketColumn = 5
Workbook = Sheets(wb_MasterData).Cells(22, 4)
Sheets(wb_RawData).Activate
Sheets(wb_RawData).Cells(104, MarketColumn).Select
Selection.End(xlUp).Select
Lastrow = ActiveCell.row
Sheets(wb_RawData).Range(Cells(2, MarketColumn), Cells(Lastrow, MarketColumn)).Select
If Not Selection Is Nothing Then
For Each Cell In Selection
If (Cell <> "") And (InStr(Temp_Value, Cell) = 0) Then
Temp_Value = Temp_Vaue & Cell & "|"
End If
Next Cell
End If
If Len(Temp_Value) > 0 Then Temp_Value = left(Temp_Value, Len(Temp_Value) - 1)
MarketArray = Split(Temp_Value, "|")
'Loop through every MarketCode
ArrayLength = UBound(MarketArray)
Application.ScreenUpdating = False
And then it copy and past the raw data into raw data sheet.
The below code is manually picking the OP file, and copy pasting in the main dashboard. But I want to automate this process.
'opening the raw data order profile dashboard
Workbooks.Open Filename:=Path & FIE_OP_RawData
'selecting the section
Range("A1:I1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'pasting in new dashboard
Windows(FIE_Model_Dashboard).Activate
Sheets(OrderProfiles_Sheet_NewDashboard).Select
Range("a1").Select
ActiveSheet.Paste
'Save Dashboard
ChDir _
Location_folder
ActiveWorkbook.SaveAs Filename:= _
Location_folder & "Dashboard - Market " & MarketArray(i) & " - " &
Run_Period & ".xlsb" _
, FileFormat:=xlExcel12, CreateBackup:=False
'Close Dashboard
ActiveWindow.Close
I wish to select same market specific OP file from folder that the loop picked from the raw data.

VBA: Tickbox - True, creates a sheet. False, deletes the sheet

I am editing an existing template in VBA. This template organises data from a "Raw Data" sheet into a "Day", "Evening" and "Night" sheet. I want to create a sheet called "Weekend", where data from "Raw Data" will be copied to if the date is not a weekday (i know how to do that bit).
However, the amount of data that runs through this template is massive, so to avoid creating a weekend sheet where the user does not need/want one I want to put in a section of code where if a tick box is ticked (True), a sheet called "Weekend" will be created (within the workbook, but inbetween existing sheets - namely inbetween a sheet called "Night" and "Graph - All Data") and when it is unticked (False) this sheet will not exist.
I thought about having this sheet to exist all the time, and to have it hidden when the tick box is unticked, however this means that the data would be still piled into it and in the interest of efficiency I would rather not have it like that.
Here is the Code I am trying to alter
Sub ToggleWindDirection()
Dim i As Long
Application.ScreenUpdating = False
If sheetArr(1) Is Nothing And LastNDRow = Empty Then
DefineLists
End If
Sheets("Raw Data").Unprotect Password:="2260"
For Each sht In sheetArr
sht.Unprotect Password:="2260"
Next
Set chtAllData = ActiveWorkbook.Charts("Graph - All Data")
With Sheets("Raw Data")
If .Range("O15").Value = True Then
'Wind direction is being used
.Range("C17:G17").Font.ColorIndex = xlAutomatic
.Range("D17").Font.ColorIndex = 9
.Range("G17").Font.ColorIndex = 9
.Range("D17").Locked = False
.Range("G17").Locked = False
.Range("F" & FirstNDRow & ":F10000").Interior.Pattern = xlNone
.Range("F" & FirstNDRow & ":F10000").Interior.PatternTintAndShade = 0
.Range("F" & FirstNDRow & ":F10000").Font.ColorIndex = xlAutomatic
Else
'Not using wind direction
.Range("C17:G17").Font.ColorIndex = 16
.Range("D17").Locked = True
.Range("G17").Locked = True
.Range("F" & FirstNDRow & ":F10000").Interior.Pattern = xlSolid
.Range("F" & FirstNDRow & ":F10000").Interior.TintAndShade = -4.99893185216834E-02
.Range("F" & FirstNDRow & ":F10000").Font.ColorIndex = 16
End If
'Addition by lewisthegruffalo 2016
Dim ws As Worksheet
If .Range("O21").Value = True Then
'create the weekend sheet
Set ws = Worksheets.Add(After:=Worksheets("Night"))
ws.Name = "Weekend"
Else
'No Weekend needed
Worksheets("Weekend").Delete
End If
End With
Sheets("Raw Data").Activate
Application.ScreenUpdating = True
End Sub
Any help would be greatly apprichiated.
Kind Regards,
lewisthegruffalo
If you want to create a new sheet using sheets.add then you can utilise the arguments in it to tell it where to put it, the msdn page has a good example at the bottom.
What you have so far? Where do you wanna call it? What checkbox shall be ticked? Please provide some code.
A general answer is this to add a new worksheet:
Dim ws As Worksheet
If Something Then
Set ws = Worksheets.Add(Before:=Worksheets("Graph - All Data"))
ws.Name = "Weekend"
'do anything you want with the ws object
End if

Resources