I am having some difficulties with macros in Excel. I have a built a call logger in a workbook containing 2 macros:
macro A moves all the data from worksheet A into worksheet B;
macro B automatically sorts the data so one column is always in descending alphabetical order.
However, I can't get both macros to work at the same time. They both work individually but when I try to implement one macro into a workbook containing the other they seem to cancel each other out. Where am I going wrong? Is there a way of possibly combining the 2 macros, for example? Macros are below.
Macro A:
Sub Macro6()
' Macro6 Macro
Application.ScreenUpdating = False
Sheets("Logger").Select
Range("B4:I4").Select
Selection.Copy
Sheets("DATA").Select
Range("B4").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Logger").Select
Range("B4:I4").Select
Selection.ClearContents
End Sub
Macro B:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Range("H3").Sort Key1:=Range("H4"), _
Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
Thank you in advance for your assistance with this.
Related
Having tried for many hours without a solution, I am asking for help to please clear the contents of Columns A through H from first row where Col G = - to row 50000. I have tried many approaches without success. Users currently have instructions to do this manually, but I sure wish it could be automated by adding it to the code below. Deleting the rows is no good because it upsets array formulas elsewhere that use this data.
Sub CopyPasteToPrYrData()
'
' CopyPasteToPrYrData Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
Sheets("Barrel List by Producer").Range("AD3:AK30000").Copy
Sheets("Prior Years Data").Range("A1:H29998").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheet1.Activate
Range("A1:B29998").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
Range("A1:H29998").Sort Key1:=Range("G1"), Order1:=xlDescending, Header:=xlNo
End Sub
I tried creating a concatenated range formula in Excel from calculated Find values, code to copy the first row with only a space in it and copying that down, building a range formula in VBA instead of Excel, and various iterations of those until I gave up on my ability to solve the problem.
you can use AutoFilter() to filter negative values and clear them
here's a possible code, where I also refactored your existing one to add more consistency
Sheets("Barrel List by Producer").Range("AD3:AK17").Copy
With Sheets("Prior Years Data")
.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
With .Range("A1").CurrentRegion
.NumberFormat = "General"
.Value = .Value
.Sort Key1:=.Range("G1"), Order1:=xlDescending, Header:=xlNo
.AutoFilter field:=7, Criteria1:="<0"
With .Resize(.Rows.Count - 1).Offset(1)
If CBool(Application.Subtotal(103, .Columns(1))) Then
.SpecialCells(xlCellTypeVisible).ClearContents
End If
End With
End With
.AutoFilterMode = False
End With
Sub CopyPasteToPrYrData()
'
' CopyPasteToPrYrData Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
Sheets("Barrel List by Producer").Range("AD3:AK30000").Copy
Sheets("Prior Years Data").Range("A1:H29998").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheet1.Activate
Range("A1:B29998").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
Range("A1:H29998").Sort Key1:=Range("G1"), Order1:=xlDescending, Header:=xlNo
Columns("G:G").Select
Selection.Find(What:="-", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End Sub
In an Excel workbook, I have two worksheets with similar structures.
I wrote VBA code that:
converts format from the text to the data in a range;
sorts the date in a range from oldest to the newest;
filters in a range by the specific characters (the full name of the head of the department, e.g. J.S.Doe);
makes active and moves the view to the top left corner cell in both worksheets;
goes to the next worksheet and repeats the code, then goes to the previous worksheet.
Sub SuperiorsOrders()
Application.ScreenUpdating = False
Range("I3", Range("I3").End(xlDown)).TextToColumns FieldInfo:=Array(1, 4)
Range("A3", "J3").End(xlDown).Sort [I2], xlAscending, Header:=xlYes
Range("A3", "J3").End(xlDown).AutoFilter Field:=8, Criteria1:="J.S.Doe"
Range("A1").Select
Application.GoTo ActiveSheet.Range("A1"), Scroll:=True
ActiveSheet.Next.Select
Range("I3", Range("I3").End(xlDown)).TextToColumns FieldInfo:=Array(1, 4)
Range("A3", "J3").End(xlDown).Sort [I2], xlAscending, Header:=xlYes
Range("A3", "J3").End(xlDown).AutoFilter Field:=8, Criteria1:="J.S.Doe"
Range("A1").Select
Application.GoTo ActiveSheet.Range("A1"), Scroll:=True
ActiveSheet.Previous.Select
Application.ScreenUpdating = True
End Sub
To reduce the code, I tried to wrap it into the For Each loop statement. It still works, but only for active worksheet, not for all of them.
Sub SuperiorsOrders()
Application.ScreenUpdating = False
Dim WS As Worksheet
For Each WS In Worksheets
Range("I3", Range("I3").End(xlDown)).TextToColumns FieldInfo:=Array(1, 4)
Range("A3", "J3").End(xlDown).Sort [I2], xlAscending, Header:=xlYes
Range("A3", "J3").End(xlDown).AutoFilter Field:=8, Criteria1:="J.S.Doe"
Range("A1").Select
Application.GoTo ActiveSheet.Range("A1"), Scroll:=True
Next WS
Application.ScreenUpdating = True
End Sub
I searched the internet, including similar questions here, but it does not work for me.
You have to add the worksheet reference to the range in the loop otherwise Range always refers to the active sheet
ws.Range("I3", ws.Range("I3").End(xlDown)).TextToColumns FieldInfo:=Array(1, 4)
' add the remaining lines of code starting with ws.
or
With ws
.Range("I3", .Range("I3").End(xlDown)).TextToColumns FieldInfo:=Array(1, 4)
' add the remaing lines of code in the same way
End With
So your code would look like that
Sub SuperiorsOrders()
Application.ScreenUpdating = False
Dim WS As Worksheet
For Each WS In Worksheets
With WS
.Range("I3", .Range("I3").End(xlDown)).TextToColumns FieldInfo:=Array(1, 4)
.Range("A3", "J3").End(xlDown).Sort [I2], xlAscending, Header:=xlYes
.Range("A3", "J3").End(xlDown).AutoFilter Field:=8, Criteria1:="J.S.Doe"
' .Range("A1").Select That is not necessary
End With
'Application.GoTo ActiveSheet.Range("A1"), Scroll:=True <= What is that good for?
Next WS
Application.ScreenUpdating = True
End Sub
Newbie here! I have an action which I'd like to repeat, for specific workbooks or specific worksheets.
Is there a way to do it without copy and pasting the whole code for the 2nd, 3rd etc worksheets?
Only the workbook and the worksheet names change. other actions (e.g. copy paste) remains the same.
Although there's a "For Each loop", but I don't know how to do it in a way that allows me to specify which worksheets exactly.
For example, I'm
Step 1: copying data from workbook "Red" sheet "Apple". paste into output
workbook.
Repeat action. Step 2: copying data from workbook "Yellow" sheet "Banana". paste into
same output workbook.
Here's my code if anyone could kindly advise. VBA newbie here thank you!
Sub CopyPastefromOtherWB()
Range("B13").Select
'Activate WB1
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Red"
Worksheets("Apple").Activate
Range("A1").Select
Do While Selection.Value <> "Mar"
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
'Activate output notebook
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
Worksheets("Sheet1").Activate
Range("B13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'HERE IS WHERE THE REPEAT HAPPENS. Activate WB2
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Yellow"
Worksheets("Banana").Activate
Range("A1").Select
Do While Selection.Value <> "Mar"
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
'Activate output notebook
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
Worksheets("Sheet1").Activate
Range("C13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
End Sub
Please see How to avoid using Select in Excel VBA.
Sub CopyPastefromOtherWB(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetCell As Range)
With Workbooks.Open(FromPath)
With .Worksheets(FromSheetName)
Dim c As Range
Set c = .Rows(1).Find("Mar", LookAt:=xlWhole).Offset(1, 0)
TargetCell.Resize(c.Rows.Count, 1).Value = .Range(c, c.End(xlDown)).Value
End With
.Close False
End With
End Sub
With Workbooks.Open("C:\Users\Desktop\My macro projects\OutputWB").Worksheets("Sheet1")
CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Red", "Apple", .Range("B13")
CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Yellow", "Banana", .Range("C13")
End With
After months of learning, I developed a solution, feel free to use the code below and tweak it to your needs. This solution is for a set area of cells.
Sub copypaste_adhoc()
Dim inputfile As Workbook
Set inputfile = Workbooks.Open("c:\path\workbook")
Dim arrSht, i
arrSht = Array("worksheet1", "worksheet2")
For i = LBound(arrSht) To UBound(arrSht)
With Worksheets(arrSht(i))
.Range("A31:Z31").Copy
ThisWorkbook.Sheets("Sheet1").Cells(Sheet5.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Next i
Application.CutCopyMode = False
Sheet5.Range("a1").CurrentRegion.EntireColumn.AutoFit
End Sub
Error 1004: the range object cannot be excuted.
Hello Gurus, I'm a newbee in Excel VBA. I just try to add automatic sorting with alphabatic order to all my worksheets in a workbook. At most worksheets, the following code works perfect. But at several worksheets in this workbook, it doesn't und returns the runtime error as the screenshot shows. I can't figure out why, really strange.The worksheets have the simplest exact same structures. Thanks a lot!
Dim r As Integer
Dim c As Integer
r = ActiveCell.Row
c = ActiveCell.Column
Application.ScreenUpdating = False
Sheets(17).Select
Range("A8:E30").Select
Selection.Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells(r, c).Select
Application.ScreenUpdating = True
I've found a snippet for selecting the next empty row in excel, but when I run the macro it tells me that it throws a runtime error 1004. Any idea why?
Sub CopyValues()
Sheets("Report").Select
Range("B4:D10").Select
Selection.Copy
Sheets("Data").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End Sub
And yes, the worksheet names are correct.
Range("A1").End(xlDown).Offset(1, 0).Select throws the error
Sub CopyValues()
Sheets("Report").Range("B4:D10").Copy _
Destination:=Sheets("Data").Range("A" & Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row + 1)
End Sub