I started learned about the existence of macros yesterday and I know nothing about VBA. This is about to become evident. I am trying to set up a workbook with one sheet as a chemical list and another sheet to load information into it. The list itself will be hidden away to from most people to keep it neat but if someone needs to add a chemical to it they will fill out a form and hit a button and it will load that information into the list. So I recorded the macro below. It is inelegant and has mistakes, I know, but it is just a kind of proof of concept at this stage. But when i run it, it always runs in the sheet I am working on rather than putting the information into the list. Any help?
Sub Insert_Chemical()
'
' Insert_Chemical Macro
'
'
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[1]"
Range("B3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[1]"
Range("C3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[1]"
Range("C4").Select
ActiveCell.FormulaR1C1 = ""
Range("D3").Select
ActiveCell.Formula2R1C1 = "='New Chmical'!RC[1]:RC[2]"
Range("E3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[2]"
Range("D3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[1]"
Range("F3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[2]"
Range("G3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[2]"
Range("H3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[2]"
Range("I3").Select
ActiveCell.FormulaR1C1 = "='New Chmical'!RC[2]"
Range("F4").Select
ActiveWorkbook.Worksheets("COSHH List").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("COSHH List").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("A1:A4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("COSHH List").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Related
Sub Print_New()
'
' Print_New Macro
'
'
ActiveSheet.Unprotect
ActiveSheet.Range("$B$7:$G$24").AutoFilter Field:=1, Criteria1:="<>"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$7:$G$24").AutoFilter Field:=1
ActiveSheet.Protect
Sheets("Bill (1)").Copy Before:=Sheets(5)
ActiveSheet.Unprotect
Range("C8:C17,D20,E20:F20").Select
Range("E20").Activate
Selection.ClearContents
Range("G20").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",5%)"
Range("F8").Select
Range("F8").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F9").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F10").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F11").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F12").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F13").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F14").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F15").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F16").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("F17").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>0,1,"""")"
Range("C8").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub
Need a proper code instead of any "IF" formula.
When I write something in any cell in the range C8:C17, the default value 1 should be equal to the same cell in the range F8:F17. Which can be changed. And when C8:C17 is empty then F8:F17 should also be empty.
Please don't do the constant Select and ActiveCell: you might replace:
Range("G20").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",5%)"
by:
Range("G20").FormulaR1C1 = "=IF(RC[-2]="""","""",5%)"
And, instead of using RC, you might do the following:
Range("G20").Formula = "=IF(Offset(-2;0)="""","""",5%)"
In top of this, you can use the whole range of F8:F17:
Range("F8:F17").Formula = "IF(Offset(-3;0)>0,1,"""")"
This is already a big decrease of obsolete code.
I have a problem with a VBA I recently coded and I have no idea why the error turns up.
The problem is that when I am running the code, it works perfectly fine. When one of my colleagues runs the code, it's perfectly fine as well. But there are some older colleagues and when they try to run the code there's the error message mentioned above.
Do you think it appears because of their older equipment or what would you suggest?
Here's the code:
Sub Datenauswerten()
Application.ScreenUpdating = False
Sheets("Auswertung").Visible = True
Sheets("Auswertung").Select
Range("A1:D100").Select
Selection.ClearContents
Sheets("Pivot").Select
Range("B6").Select
ActiveWorkbook.RefreshAll
Range("D7").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Sheets("Auswertung").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Auswertung").Range("b1").Value = "Kategorie"
Sheets("Auswertung").Range("c1").Value = "Störung"
Sheets("Auswertung").Range("d1").Value = "Dauer [h]"
Cells.Select
Cells.EntireColumn.AutoFit
Range("D1").Select
ActiveWorkbook.Worksheets("Auswertung").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Auswertung").Sort.SortFields.Add
Key:=Range("D1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Auswertung").Sort
.SetRange Range("A2:D100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5:D100").Select
Selection.ClearContents
Range("A:A").Select
Selection.ClearContents
Columns("D:D").Select
Selection.NumberFormat = "0.00"
Sheets("Auswertung").Range("b1").Value = "Kategorie"
Sheets("Auswertung").Range("c1").Value = "Störung"
Sheets("Auswertung").Range("d1").Value = "Dauer [h]"
Sheets("Auswertung").Range("A1").Select
Sheets("Grafik").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(1).Values = "=Auswertung!$D$2:$D$4"
ActiveChart.FullSeriesCollection(1).XValues = "=Auswertung!$B$2:$C$4"
Sheets("Auswertung").Select
Range("A50").Select
Sheets("Auswertung").Visible = False
Application.ScreenUpdating = True
End Sub
Thank you very much for your help!
I need to copy a list from Column C that has blanks throughout the column to Column 0 sorted to remove the blanks. I need to do this on Multiple sheets represent the month (Jan, Feb, Mar, Apr....). The issue I run into is it uses: ActiveWorkbook.Worksheets("Jan") so if I do a do loop to get the other months (Feb, Mar....) then it won't work.
Essentially what I'm trying to get is a master list of all the names in column C from each month for a summary tab listing all the names from the various months. Depending on the month I run this the file will only have sheets for the months that have occurred.
Below is my code:
'First Tab
Columns("C:C").Select
Selection.Copy
Columns("O:O").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With ActiveWorkbook.Worksheets("Jan").Sort
.SetRange Range("O1:O1590")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("o:o").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("o:o", Range("o:o").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
'Add the managers to the next sheet
Range("O1").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("p1").Select
ActiveSheet.Paste
End With
ActiveSheet.Next.Select
'''''''''''''''''''''
'''''''''''''''''''''
Do
Columns("C:C").Select
Selection.Copy
Columns("O:O").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With ActiveWorkbook.Worksheets("Jan").Sort
.SetRange Range("O1:O1590")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("o:o").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("o:o", Range("o:o").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
'Add the names to the next sheet
Range("O1").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("p1").Select
' Selection.End(xlDown).Select
' Selection.End(xlUp).Select
ActiveSheet.Paste
ActiveSheet.Previous.Select
Range("O1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("O1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Selection.End(xlDown).Select
Selection.End(xlDown).Select
End With
If ActiveSheet.Next.Name = "Summary" Then
Exit Do
ElseIf ActiveSheet.Index <> Sheets.Count Then
ActiveSheet.Next.Select
Else
Exit Do
End If
Loop
ActiveSheet.Next.Select
Range("A1").Select
Sheets("Summary").Select
ActiveSheet.Previous.Select
Columns("O:O").Select
Selection.Copy
ActiveSheet.Next.Select
ActiveWindow.ScrollColumn = 2
Columns("AC:AC").Select
ActiveSheet.Paste
Range("AC2").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 1
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'ActiveSheet.Range("$A$2:$A$43").RemoveDuplicates Columns:=1, Header:=xlYesActiveSheet.Range.Cells("a1").Select
Sheets("Guide").Select
End Sub
You can use Format() to get the worksheet names.
Below is an example of using it for your purpose. You will need to modify your code to work with inputting either the Worksheet name as String or the Worksheet Object itself. sName is what you are stuck on from this post. Example here uses the Worksheet Object Reference.
Option Explicit
Sub ProcessAllMonthsWorksheet()
Dim iMonth As Integer, iYear As Integer, sName As String
Dim oWS As Worksheet
iYear = Year(Date)
On Error Resume Next
For iMonth = 1 To 12
sName = Format(DateSerial(iYear, iMonth, 1), "mmm")
Debug.Print "sName: " & sName
Set oWS = ThisWorkbook.Worksheets(sName)
If Not oWS Is Nothing Then ProcessMonthWorksheet oWS
Set oWS = Nothing
Next
End Sub
Private Sub ProcessMonthWorksheet(ByRef WorksheetObject As Worksheet)
Debug.Print "Processing worksheet """ & WorksheetObject.Name & """"
With WorksheetObject
' do your stuff with the worksheet
End With
End Sub
I've created a macro to organize a data set and compile into another sheet in a way that makes more sense for doing analyses. The set originally is comprised of columns for user, timestamp and 3 possible events. The user could appear on multiple rows but I wanted to look at this data set by user and have a separate column for each timestamp. The macros I've made can successfully clean, filter by event type, and separate by event type into separate worksheets (no matter how many rows of data) but I'm having trouble with compiling data into one sheet using vlookup AND accounting for a variable number of rows. I have looked at other answers to this question and tried this:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Email Opened'!R1C1:R" & LastRow0 & "C3,2,FALSE)"
... but it keeps giving me errors.
What I have below (Vlookup_events2) works but just not for the entire variable number of rows.Please help me adjust the code for the vlookup so it will work no matter how many rows.
Here is the code below for separating data (just for reference), then the problem macro - compiling it with vlookup. I would really appreciate some help, I know there's an amazing VBA expert out there!
Sheets.Add
Sheets("Sheet1").Name = "Email Sent"
ActiveSheet.Next.Select
Selection.AutoFilter
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Range("$A$1:$D$1000000").AutoFilter Field:=3, Criteria1:= _
"=Campaign Created", Operator:=xlOr, Criteria2:="=Email Sent"
ActiveCell.Offset(0, -2).Range("A1:D2355").Select
ActiveCell.Activate
Selection.Copy
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Range("$A$1:$D$1000000").AutoFilter Field:=3, Criteria1:= _
"=Campaign Created", Operator:=xlOr, Criteria2:="=Email Opened"
Sheets.Add
Sheets("Sheet2").Name = "Email Opened"
ActiveSheet.Next.Select
ActiveCell.Range("A1:D1000000").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets.Add
Sheets("Sheet3").Name = "Clicked Link"
ActiveSheet.Next.Select
ActiveSheet.Next.Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Range("$A$1:$D$1000000").AutoFilter Field:=3, Criteria1:= _
"=Campaign Created", Operator:=xlOr, Criteria2:="=Clicked Link"
ActiveCell.Offset(0, -2).Range("A1:D1000000").Select
ActiveCell.Activate
Selection.Copy
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
Sub Vlookup_events2()
' Vlookup_events2 Macro
ActiveSheet.Previous.Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "user"
Range("A3").Select
ActiveSheet.Next.Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "user"
Range("A3").Select
ActiveSheet.Next.Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "user"
Range("A3").Select
Sheets.Add
Sheets("Sheet4").Name = "Compiled Events"
ActiveSheet.Previous.Select
ActiveSheet.Previous.Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Next.Select
Range("A1").Select
ActiveSheet.Paste
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "Email Sent Time"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Email Opened Time"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Clicked Link Time"
Range("A1").Select
Application.Goto Reference:="R2C3"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Email Opened'!R1C1:R601C3,2,FALSE)"
Range("C3").Select
Range(Selection, Selection.End(xlUp)).Select
Columns("C:C").Select
Selection.FormulaR1C1 = "=VLOOKUP(RC[-2],'Email Opened'!R1C1:R601C3,2,FALSE)"
Columns("D:D").Select
Selection.FormulaR1C1 = "=VLOOKUP(RC[-3],'Clicked Link'!R1C1:R56C3,2,FALSE)"
Columns("C:C").Select
Selection.NumberFormat = "m/d/yyyy h:mm"
Columns("D:D").Select
Selection.NumberFormat = "m/d/yyyy h:mm"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Email Opened Time"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Clicked Link Time"
Range("C2").Select
End Sub
I have a file that has a vba macro to paste and sort data.
Now everytime i save the file, when opening it says it has a problem = removed records :sorting from sheet3 ( even tough i do not have a sheet3 in my file) , and my file gets corrupted and 'locked for editing' .
Thank you in advance for any help.
' sum Macro
Range("A3").Select
ActiveCell.FormulaR1C1 = "=Pivot!R[3]C"
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A1500"), Type:=xlFillDefault
Range("A3:A1500").Select
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFill Destination:=Range("A3:ab1500"), Type:=xlFillDefault
Range("A3:ab1500").Select
Range("AC3").Select
Range("AC3").Select
ActiveCell.FormulaR1C1 = "=RC[-12]+RC[-10]+RC[-8]+RC[-6]+RC[-4]+RC[-2]+RC[-14]+RC[-16]+RC[-20]+RC[-18]+RC[-22]+RC[-24]"
Range("AC3").Select
Selection.AutoFill Destination:=Range("AC3:AC1500")
Range("AC3:aC1500").Select
ActiveWindow.SmallScroll Down:=60
Range("ac3").Select
Range("A3:ac1500").Select
Selection.copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("ac2").Select
Application.CutCopyMode = False
Range("ac2").Select
ActiveWorkbook.Worksheets("Summary table").Sort.SortFields.Add Key:=Range( _
"ac2:ac1500"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Summary table").Sort
.SetRange Range("A2:ac1500")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3").Select
'
End Sub
Try "File"-> "Options"->"Advanced"-> scroll down to see title,"When calculating this workbook"->check the box "update links to other documents" -> "Ok" and then try executing your code.
Recommended reading: How to avoid using Select in Excel VBAIt is better to get away from Select and Activate sooner than later.
Here is what is actually necessary for your code to execute everything from the original above.
Option Explicit
Sub summmit()
With ActiveWorkbook.Worksheets("Summary table")
.Activate
.Range("A3:AB1500").FormulaR1C1 = "=Pivot!R[3]C"
.Range("AC3:AC1500").FormulaR1C1 = _
"=RC[-24]+RC[-22]+RC[-20]+RC[-18]+RC[-16]+RC[-14]+RC[-12]+RC[-10]+RC[-8]+RC[-6]+RC[-4]+RC[-2]"
.Range("A3:ac1500") = .Range("A3:ac1500").Value
With .Range("A2:ac1500")
.Cells.Sort Key1:=.Columns(29), Order1:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
.Range("A3").Select
End With
End Sub
There does not appear to be any 'workbook-breaking' operations. Two things do come to mind: a) refresh the pivot table on the Pivot worksheet and b) start writing your formulas in xlA1 rather than the recorded xlR1C1 reference style. Additionally, the solution recommended by arun v shows merit.