I have a form that I have created in Excel as an input area for Production Information. Once the data has been filled into the Form I have a save button with a macro behind it. This to copy and paste the data from the form into a line in the Info Log area below the form.
I have tried to use a "helper" column to place True if the information being saved has already been saved once. I am not sure I have all of that correct either.
Sub Record_Save()
'With Sheets("Roll Line Form")
'Application.ScreenUpdating = False
'Range("B43:B" & Cells(Rows.Count, 1).End(xlUp).Row) =
"=CountIf(D2:D4,D2,)>1"
'Range("B:B").AutoFilter 1, "True"
'If .Range("B:B").Value = "True" Then
'MsgBox "This has already been entered"
'Exit Sub
'End If
'End With
With Sheets("Roll Line Form")
If .Range("D2").Value = Empty Then
MsgBox "Please Enter a Date"
Exit Sub
End If
RecordRow = .Range("C999999").End(xlUp).Row + 1 'Find First Available Row
For RecordCol = 3 To 46
.Cells(RecordRow, RecordCol).Value = .Range(.Cells(41,
RecordCol).Value).Value
Next RecordCol
End With
End Sub
I want to have the Macro understand that the data is already saved and not to save the data in the Log area. I have commented out the code I tried to use but when it was still running I would get the error code of Run-time error '1004': Application-defined or object error
This is on the line that starts Range ("B43:B"...
Related
I am trying to automatically change the filtered range in a multiple pivot tables to a desired four week range at the same time instead of having to manually filter them all.
The Weeks are defined by week numbers 1-52 and not as dates. I have been unable to get any version of code to work on an individual pivot table and have not attempted to write the VBA to affect multiple tables at once.
Example of pivot table and 4 week range set up
Here is the last attempt. It resulted in
Run-time error '1004': Application-defined or object-defined error
highlighting the last line of code.
Sub Updateweekrange1()
If Range("T2").Value = "" Then
MsgBox ("You Must First Enter a Beginning Week#.")
Exit Sub
End If
If Range("V2").Value = "" Then
MsgBox ("You Must First Enter a Ending Week#.")
Exit Sub
End If
With ActiveSheet.PivotTables("Test2").PivotFields("Week")
.ClearAllFilters
.PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables("Test2").PivotFields("Week"), Value1:=Range("T2").Value, Value2:=Range("V2").Value
End With
End Sub
I tested the below and it worked for me.
I solved this by recording a macro (via the initially hidden developer tab), whilst I set a between filter on the Week column and then examined the generated code.
Setting wsPivot to ActiveSheet or perhaps Sheets("Sheet1") for example can allow a bit more flexibility in our coding. I'm autistic; so I can sometimes appear to be schooling others, when I'm only trying to help.
Option Explicit
Private Sub Updateweekrange1()
Dim wsPivot As Worksheet
Set wsPivot = ActiveSheet
If wsPivot.Range("T2").Value = "" Then
MsgBox ("You Must First Enter a Beginning Week#.")
Exit Sub
End If
If wsPivot.Range("V2").Value = "" Then
MsgBox ("You Must First Enter a Ending Week#.")
Exit Sub
End If
With wsPivot.PivotTables("Test2").PivotFields("Week")
.ClearAllFilters
.PivotFilters.Add2 _
Type:=xlValueIsBetween, DataField:=wsPivot.PivotTables("Test2"). _
PivotFields("Sum of Cost"), Value1:=wsPivot.Range("T2").Value, Value2:=wsPivot.Range("V2").Value
End With
End Sub
I am currently trying to write a piece of code where someone is able to use a checkbox to choose which worksheets they would like to keep and what they would like removed. Here is what that looks like:
(currently debating if I should turn this into a userform but i would still be stuck at this point).
What I would like to do is if the checkbox is unchecked (false) on the worksheet called "Setup", delete the worksheet and move onto the next if statement. From the code below, I am prompt with the run-time error '1004': Unable to get the OLEObjects property of the worksheet class. I have checked and the Checkbox name is the same as what I have in my code.
Sub DeleteSheetCB()
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox1") = False Then
ThisWorkbook.Worksheets("Program Information").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox2") = False Then
ThisWorkbook.Worksheets("Spend and Trx Data").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox3") = False Then
ThisWorkbook.Worksheets("Requirements").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox4") = False Then
ThisWorkbook.Worksheets("TMC Overview").Delete
End If
End Sub
Thank you in advance
EDIT:
I was able to get this piece of code to delete sheets but if possible, would someone be able to sense check this for me please?
Sub DeleteSheetCB()
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 1").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Program Information").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 2").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Spend and Trx Data").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 3").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Requirements").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 4").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("TMC Overview").Delete
Else: End If
End Sub
The main thing I'd take from your second code is:
It will give you a warning before it deletes each sheet
You'll get a subscript out of range error if the sheet has already been deleted.
You have to update your code if you add a new tick box.
The code below assumes the caption of the checkbox is exactly the same as the name of the sheet to be deleted.
Sub DeleteSheetCB()
Dim chkBox As CheckBox
Dim sMissing As String
With ThisWorkbook.Worksheets("Setup")
For Each chkBox In .CheckBoxes 'Look at all checkboxes in Setup sheet.
If chkBox.Value = 1 Then 'If it's ticked.
If WorksheetExists(chkBox.Caption) Then 'Check worksheet exists.
Application.DisplayAlerts = False 'Turn off warnings about deleting a sheet.
ThisWorkbook.Worksheets(chkBox.Caption).Delete
Application.DisplayAlerts = True 'Turn on warnings about deleting a sheet.
Else
sMissing = sMissing & "- " & chkBox.Caption & vbCr
End If
End If
Next chkBox
End With
If sMissing <> "" Then
MsgBox "These sheet(s) could not be deleted as they were already missing: " & vbCr & vbCr & sMissing
End If
End Sub
Public Function WorksheetExists(SheetName As String) As Boolean
Dim wrkSht As Worksheet
On Error Resume Next
Set wrkSht = ThisWorkbook.Worksheets(SheetName) 'Try and set a reference to the sheet.
WorksheetExists = (Err.Number = 0) 'Was an error thrown?
On Error GoTo 0
End Function
Might also be worth mentioning that you can rename your checkboxes:
Select a check box so the Shape Format ribbon becomes visible.
Click Selection Pane under the Arrange section.
A sidebar will appear showing the shapes on the sheet. You can rename or change their visibility here.
chkRemoveProgramInfo makes more sense than Check Box 1.
I am currently linking lots of subs together to format headings in excel for upload to other dashboard software. The headings need to be in a certain order. I am running several subs triggered by a command button to search for the heading text in a sepcified range of cells. having trouble with if the heading isn't found which sometimes happens as the data is downloaded from brandwatch and if nothing returns for that particular subject in Brandwatch then the heading isn't in the downloaded data file. I want the macro to stop when the required text isn't found in the range.
I am only just learning VB and have no idea how to stop the next sub from running if the specific text isnt found. As it stands at the minute it is putting in another heading as the next subroutine is a copy active column and then goto another specific column and paste.
The message 'The Value you are searching for is not available' comes up but then the next sub pastes the wrong heading in when I just want all the macros to stop at that point.
Any help would be greatly appreciated.
Thanks Sylly
the offending Subroutine is below
Sub FIND_POTENTIAL_IRRELEVANT_MENTIONS()
'============================
'FIND POTENTIAL_IRRELEVANT_MENTIONS
'============================
Dim MyValue As Variant
On Error Resume Next
Range("CT9:HD9").Find(What:="Market Insight Report").Select
On Error GoTo 0
MyValue = ActiveCell.Value
If MyValue = "" Then
MsgBox "The Value you are searching for is not available"
Else
MsgBox MyValue & " found in " & ActiveCell.Address
End If
End Sub
Sub addinfo()
If Range("FH17") = "Unlocked" Then
Result = MsgBox("Are you sure you want to add information for a new year? (This is only to be done after you have created a new workbook for a new year)", vbYesNo + vbQuestion)
If Result = vbYes Then
Range("FH17").Value = "Locked"
'creating template
Set wk = ThisWorkbook
Dim template As String
template = Sheets("Data").Range("EW12").Value
'add template
wk.Sheets("Data").Range("A1:BC1000").Copy wk.Sheets(template).Range("A1")
'add old info
wk.Sheets("Data").Range("IE5:IK1000").Copy wk.Sheets(template).Range("A5")
wk.Sheets("Data").Range("IL5:IM1000").Copy wk.Sheets(template).Range("J5")
wk.Sheets("Data").Range("IN5:IW1000").Copy wk.Sheets(template).Range("O5")
'change date
wk.Sheets("Data").Range("EX12").Copy wk.Sheets(template).Range("E1")
'copy format to template
wk.Sheets("Data").Range("A:BC").Copy
wk.Sheets(template).Range("A1").Parent.Activate
wk.Sheets(template).Range("A1").PasteSpecial xlPasteColumnWidths
wk.Sheets(template).Range("A1").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
'unhide columns
wk.Sheets(template).Range("A:BC").Select
Selection.EntireColumn.Hidden = False
'Hide columns
wk.Sheets(template).Range("AC:AD").Select
Selection.EntireColumn.Hidden = True
wk.Sheets(template).Range("AM:AN").Select
Selection.EntireColumn.Hidden = True
wk.Sheets(template).Range("AR:AT").Select
Selection.EntireColumn.Hidden = True
wk.Sheets(template).Range("A1").Select
Call rows_freeze
'Protect the sheet
ActiveSheet.Protect
MsgBox "Done."
Else
Range("FH17").Value = "Locked"
End If
End If
End Sub
This is my code, it works fine. except the part of calling on "row_freeze". I tried not having it as 2 macros but that didnt work either. I get a 400 error message. Anyone with any idea? The only part that actually needs to be fixed is the code below, I'm trying to autofit row 3 and then freeze everything above cell A4. (I tried to skip the "Rows("3:3").Select" and that did nothing)(the code works if I do it in a an new empty workbook)
Sub rows_freeze()
Rows("3:3").Select
Rows("3:3").EntireRow.AutoFit
Range("A4").Select
ActiveWindow.FreezePanes = True
End Sub
EDIT:
I format the width of the columns, I believe that it sometimes "has time" to make the columns big enough for the text to fit. but sometimes it does not and the "wrap text" causes the rows to get very long(height). I removed both lines of code(rows and freeze) and I dont get any error message (this time the rows actually did not need to be autofitted, but sometimes they do).
EDIT 2:
'copy sheet to new workbook
sheettocopy = Range("EW10").Value
Worksheets(sheettocopy).Copy
Dim wb As Workbook
'Store new workbook into a variable
Set wb = ActiveWorkbook
'Fix any macro assigned buttons
Call FixMacroLinks(wb)
'adding sheet and renaming
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Sheets("Data").Range("EW12").Value
ActiveWorkbook.Sheets("Data").Activate
MsgBox "Done."
Else
MsgBox "You do not have a december month"
Range("FF17").Value = "Locked"
This is the code when creating the new workbook. The first thing I do when this is done, is to start the "Addinfo" sub
I have not worked with your sheet before, but I found that I was having the same problem of a 400 error while trying to autofit columns. I was able to resolve the issue when I put my code for autofitting my columns before my code for protecting my cells.
I have read through the multiple Q&As on error handling in VBA but for some reason my code does not work. I am trying to filter for a specific word (variable name "item"), if the filtered range does not have the word, it must skip the code and jump to error handler (and go to the next word). This must be continued until the for is done. My code is below:
Sub Group_Button1_Click()
Worksheets("Grouping_Name").Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
lastrow_grouping = Selection.Count + 1
Dim filterRange As Range
Dim copyRange As Range
Dim lastrow_To_be_grouped As Long
For grouping_counter = 2 To lastrow_grouping
' on to_be_grouped sheet turn off any autofilters that are already set Sheets("To_be_grouped").AutoFilterMode = False
' find the last row with data in column A of To_be_grouped sheet
lastrow_To_be_grouped = Sheets("To_be_grouped").Range("A" & Sheets("To_be_grouped").Rows.Count).End(xlUp).Row
' the range that we are auto-filtering (all columns)
Set filterRange = Sheets("To_be_grouped").Range("A1:B" & lastrow_To_be_grouped)
' Copy filtered data (exclude header) in To_be_grouped sheet
Set copyRange = Sheets("To_be_grouped").Range("A2:B" & lastrow_To_be_grouped)
' Assign variable "item" which is the word to filter
Item = Sheets("Grouping_Name").Range("A" & grouping_counter).Value
' Filter column with variable item
filterRange.AutoFilter field:=2, Criteria1:="=*" & Item & "*", Operator:=xlAnd
' copy the visible cells to Final_Grouping sheet
' determine first row with no data in Final Grouping sheet and copy to sheet
On Error GoTo errorhandler
' This is where I need help, if there is no line with the filtered word the code must jump to errorhandler
If IsNumeric(copyRange.SpecialCells(xlCellTypeVisible).Count) = True Then
copyRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Final_Grouping").Range("A" & item_counter_total)
' delete the tables
Sheets("To_be_grouped").Range("$A$1:$B$" & lastrow_To_be_grouped).Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
' Count the number of rows added
item_counter = copyRange.SpecialCells(xlCellTypeVisible).Count / 2
' ------------------------------------------
For group_table_counter = item_counter_total To item_counter_total + item_counter - 1 Step 1
Sheets("Final_Grouping").Range("C" & group_table_counter).Value = Item
Next group_table_counter
' ------------------------------------------
item_counter_total = item_counter_total + item_counter
End If
errorhandler:
Next grouping_counter
End Sub
Any assistance will be greatly appreciated. Thank you
I can't tell what your code is doing exactly or what the error that you are trying to capture is, but one of the problems you are having is that you can't put "Next grouping_counter" in the error handler.
I think your misunderstanding is based on the fact that if you put in an "On Error GoTo ErrorHandler" statement, the code in the ErrorHandler will be run in the case of an error.
But when the code is compiled, VBA is trying to determine whether the code makes sense and is giving you an error that there is no For Loop for your next statement, because, while if an error were to occur where you expect it to, you would be within a for loop, the program is not aware of this.
As sous2817 mentioned in a comment, you likely do not need error handling here, but I will present both methods so you can better understand how to do error handling.
In this case, you could use ErrorHandling in a couple of ways, assuming that an error occurs in your code:
1.
For grouping_counter = 2 To lastrow_grouping
'some code here
On Error GoTo ErrorHandler
'code that has error you are trying to handle
'more code to run
NextGroupingCounter: 'label to jump to from error handler
Next grouping_counter
Exit Sub
ErrorHandler:
GoTo NextGroupingCounter
End Sub
Of course, this is if you don't actually want to do anything with the error other than skip the rest of the code. If that is what you want, then just change the On Error Code to GoTo the NextGroupingCOunter label!
2.
For grouping_counter = 2 To lastrow_grouping
'some code here
On Error GoTo NextGroupingCounter
'code that has error you are trying to handle
'more code to run
NextGroupingCounter: 'label to jump to from error handler
Next grouping_counter
Of course, you likely don't even need the error handling
3.
For grouping_counter = 2 To lastrow_grouping
'some code here
If [*insert text to check condition needed for no error*] Then
'code to run if no error
End If
'If the condition needed for no error is false, this will just go to the next one.
Next grouping_counter
Option 3 is preferred if possible. If an error will actually occur in your code, then Option 2 will work fine. If you want to capture the error and then jump back into your loop, Option 3 works.
Additionally, notice that I put "Exit Sub" above the ErrorHandler. The ErrorHandler label is just a label, so if the program runs until the end, it will run the code in the ErrorHandler section. The Exit Sub ends the procedure to avoid this.
Also note that for other circumstances, you could use "On Error Resume Next" to just continue in the case of an error or even put "Resume Next" in your error handler to return to the line after the one of error. This is a bit beyond the scope of the question, but may add some useful info.